From 801840283b1c511d420f3d918297f9a4ed1eaf49 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 11 Jun 2026 16:56:07 -0700 Subject: [PATCH 01/53] Transcription of Bundle 9 - ATAN.ASM Code and Listing --- 2_printed_files/bundle_09/ATAN.ASM | 240 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/ATAN.ASM | 112 ++++++++++++++ 2 files changed, 352 insertions(+) create mode 100644 2_printed_files/bundle_09/ATAN.ASM create mode 100644 3_source_code/BASLIB-86/ATAN.ASM diff --git a/2_printed_files/bundle_09/ATAN.ASM b/2_printed_files/bundle_09/ATAN.ASM new file mode 100644 index 0000000..46a75e9 --- /dev/null +++ b/2_printed_files/bundle_09/ATAN.ASM @@ -0,0 +1,240 @@ +ATAN - Arc tangent Macro-86 %1(12) 0:58:20 13-Nov-81 Page 1-1 + + + + 1 TITLE ATAN - Arc tangent + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:BYTE, $AC:WORD, $ARG:WORD, $TEMP:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 10 + 11 EXTRN $ONE:WORD,$HALFPI:WORD,$SIXTHPI:WORD,$SQRT3:WORD + 12 EXTRN $TANTWELFTHPI:WORD + 13 + 14 ;Coefficients for Hart 4940, relative error 7.69 + 15 ;ATAN(x) = xP(x^2) + 16 ; These constants have been checked with MuMath + 17 + 18 0000 0003 ATANTAB DW 3 ;Degree + 19 0002 62 35 83 7E DB 062H,035H,083H,07EH ;-0.12813 3334 + 20 0006 50 24 4C 7E DB 050H,024H,04CH,07EH ;+0.19935 72694 + 21 000A 79 A9 AA 7F DB 079H,0A9H,0AAH,07FH ;-0.33332 42344 5 + 22 000E 00 00 00 81 DB 000H,000H,000H,081H ;+0.99999 99797 73 + 23 + 24 0012 CONST ENDS + 25 + 26 + 27 DC GROUP DATA,CONST + 28 + 29 + 30 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 31 + 32 PUBLIC $ATN + 33 + 34 EXTRN $SAVREG:NEAR, $SPOLYX:NEAR + 35 EXTRN $SDIV:NEAR, $SMUL:NEAR, $SADD:NEAR, $SSUB:NEAR, $SCMP:NEAR + 36 + 37 ASSUME CS:CODE, DS:DC, ES:DC + 38 + 39 + 40 ;$ATN - Arc tangent + 41 ; + 42 ; Inputs: + 43 ; BX = Address of argument + 44 ; Outputs: + 45 ; Result in FAC + 46 ; Registers: + 47 ; Only F affected. + 48 + 49 0000 $ATN: + 50 0000 E8 0000 E CALL $SAVREG + 51 0003 8B F3 MOV SI,BX + 52 0005 BF 0000 E MOV DI,OFFSET DC:$AC + 53 0008 A5 MOVSW ;Put in FAC + 54 0009 AD LODSW + + +ATAN - Arc tangent Macro-86 %1(12) 0:58:20 13-Nov-81 Page 1-2 + + + + 55 000A AB STOSW + 56 000B 0A E4 OR AH,AH ;Is it zero? + 57 000D 74 11 JZ DONE ;If so, result is too + 58 000F A8 80 TEST AL,80H ;Check sign + 59 0011 79 0E JNS POSATAN + 60 0013 24 7F AND AL,7FH + 61 0015 A2 FFFF E MOV [$FAC-1],AL ;Make it positive + 62 0018 E8 0021 R CALL POSATAN ;Take arctan of positive number + 63 001B 80 36 FFFF E 80 XOR [$FAC-1],80H ;Invert sign back + 64 0020 C3 DONE: RET + 65 + 66 0021 POSATAN: + 67 0021 80 FC 81 CMP AH,81H ;Is it >= 1? + 68 0024 72 15 JB LESSTHAN1 + 69 0026 BE 0000 E MOV SI,OFFSET DC:$ONE + 70 0029 BF 0000 E MOV DI,OFFSET DC:$AC + 71 002C E8 0000 E CALL $SDIV ;It's reciprocal is < 1 + 72 002F E8 003B R CALL LESSTHAN1 ;Compute arc-cotan on number < 1 + 73 0032 BE 0000 E MOV SI,OFFSET DC:$HALFPI + 74 0035 BF 0000 E MOV DI,OFFSET DC:$AC + 75 0038 E9 0000 E JMP $SSUB ;Correct by subtracting from PI/2 + 76 + 77 003B LESSTHAN1: + 78 003B BE 0000 E MOV SI,OFFSET DC:$TANTWELFTHPI + 79 003E BF 0000 E MOV DI,OFFSET DC:$AC + 80 0041 E8 0000 E CALL $SCMP ;Compare argument to PI/12 + 81 0044 73 40 JAE DOATAN ;Range reduction complete if <= PI/12 + 82 0046 BE 0000 E MOV SI,OFFSET DC:$AC + 83 0049 BF 0000 E MOV DI,OFFSET DC:$ARG + 84 004C A5 MOVSW ;Save X in ARG + 85 004D A5 MOVSW + 86 004E BE 0000 E MOV SI,OFFSET DC:$SQRT3 ;Point to TAN(PI/6) (PI/6 = 30 degrees) + 87 0051 BF 0000 E MOV DI,OFFSET DC:$AC + 88 0054 E8 0000 E CALL $SADD ;FAC = X + TAN(PI/6) + 89 0057 BE 0000 E MOV SI,OFFSET DC:$AC + 90 005A BF 0000 E MOV DI,OFFSET DC:$TEMP + 91 005D A5 MOVSW ;Save in TEMP + 92 005E A5 MOVSW + 93 005F BE 0000 E MOV SI,OFFSET DC:$SQRT3 + 94 0062 BF 0000 E MOV DI,OFFSET DC:$ARG + 95 0065 E8 0000 E CALL $SMUL ;FAC = X * TAN(PI/6) + 96 0068 BE 0000 E MOV SI,OFFSET DC:$AC + 97 006B BF 0000 E MOV DI,OFFSET DC:$ONE + 98 006E E8 0000 E CALL $SSUB ;FAC = X * TAN(PI/6) - 1 + 99 0071 BE 0000 E MOV SI,OFFSET DC:$AC + 100 0074 BF 0000 E MOV DI,OFFSET DC:$TEMP + 101 0077 E8 0000 E CALL $SDIV ;FAC = (X*TAN(PI/6) - 1)/(X + TAN(PI/6) + 102 007A E8 0086 R CALL DOATAN ;Comput e arctan on argument < PI/12 + 103 007D BE 0000 E MOV SI,OFFSET DC:$SIXTHPI + 104 0080 BF 0000 E MOV DI,OFFSET DC:$AC + 105 0083 E9 0000 E JMP $SADD ;Correct for range reduction by adding PI/6 + 106 + 107 0086 DOATAN: + 108 0086 BB 0000 R MOV BX,OFFSET DC:ATANTAB + + +ATAN - Arc tangent Macro-86 %1(12) 0:58:20 13-Nov-81 Page 1-3 + + + + 109 0089 E9 0000 E JMP $SPOLYX + 110 + 111 008C CODE ENDS + 112 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +ATAN - Arc tangent Macro-86 %1(12) 0:58:20 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 008C BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 0012 WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +ATANTAB. . . . . . . . . . . . . L WORD 0000 CONST +DOATAN . . . . . . . . . . . . . L NEAR 0086 CODE +DONE . . . . . . . . . . . . . . L NEAR 0020 CODE +LESSTHAN1. . . . . . . . . . . . L NEAR 003B CODE +POSATAN. . . . . . . . . . . . . L NEAR 0021 CODE +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$ATN . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$HALFPI. . . . . . . . . . . . . V WORD 0000 CONST External +$ONE . . . . . . . . . . . . . . V WORD 0000 CONST External +$SADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SCMP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SIXTHPI . . . . . . . . . . . . V WORD 0000 CONST External +$SMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SPOLYX. . . . . . . . . . . . . L NEAR 0000 CODE External +$SQRT3 . . . . . . . . . . . . . V WORD 0000 CONST External +$SSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$TANTWELFTHPI. . . . . . . . . . V WORD 0000 CONST External +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/ATAN.ASM b/3_source_code/BASLIB-86/ATAN.ASM new file mode 100644 index 0000000..118c763 --- /dev/null +++ b/3_source_code/BASLIB-86/ATAN.ASM @@ -0,0 +1,112 @@ + TITLE ATAN - Arc tangent + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE, $AC:WORD, $ARG:WORD, $TEMP:WORD + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $ONE:WORD,$HALFPI:WORD,$SIXTHPI:WORD,$SQRT3:WORD + EXTRN $TANTWELFTHPI:WORD + +;Coefficients for Hart 4940, relative error 7.69 +;ATAN(x) = xP(x^2) +; These constants have been checked with MuMath + +ATANTAB DW 3 ;Degree + DB 062H,035H,083H,07EH ;-0.12813 3334 + DB 050H,024H,04CH,07EH ;+0.19935 72694 + DB 079H,0A9H,0AAH,07FH ;-0.33332 42344 5 + DB 000H,000H,000H,081H ;+0.99999 99797 73 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $ATN + + EXTRN $SAVREG:NEAR, $SPOLYX:NEAR + EXTRN $SDIV:NEAR, $SMUL:NEAR, $SADD:NEAR, $SSUB:NEAR, $SCMP:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;$ATN - Arc tangent +; +; Inputs: +; BX = Address of argument +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$ATN: + CALL $SAVREG + MOV SI,BX + MOV DI,OFFSET DC:$AC + MOVSW ;Put in FAC + LODSW + STOSW + OR AH,AH ;Is it zero? + JZ DONE ;If so, result is too + TEST AL,80H ;Check sign + JNS POSATAN + AND AL,7FH + MOV [$FAC-1],AL ;Make it positive + CALL POSATAN ;Take arctan of positive number + XOR [$FAC-1],80H ;Invert sign back +DONE: RET + +POSATAN: + CMP AH,81H ;Is it >= 1? + JB LESSTHAN1 + MOV SI,OFFSET DC:$ONE + MOV DI,OFFSET DC:$AC + CALL $SDIV ;It's reciprocal is < 1 + CALL LESSTHAN1 ;Compute arc-cotan on number < 1 + MOV SI,OFFSET DC:$HALFPI + MOV DI,OFFSET DC:$AC + JMP $SSUB ;Correct by subtracting from PI/2 + +LESSTHAN1: + MOV SI,OFFSET DC:$TANTWELFTHPI + MOV DI,OFFSET DC:$AC + CALL $SCMP ;Compare argument to PI/12 + JAE DOATAN ;Range reduction complete if <= PI/12 + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG + MOVSW ;Save X in ARG + MOVSW + MOV SI,OFFSET DC:$SQRT3 ;Point to TAN(PI/6) (PI/6 = 30 degrees) + MOV DI,OFFSET DC:$AC + CALL $SADD ;FAC = X + TAN(PI/6) + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$TEMP + MOVSW ;Save in TEMP + MOVSW + MOV SI,OFFSET DC:$SQRT3 + MOV DI,OFFSET DC:$ARG + CALL $SMUL ;FAC = X * TAN(PI/6) + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ONE + CALL $SSUB ;FAC = X * TAN(PI/6) - 1 + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$TEMP + CALL $SDIV ;FAC = (X*TAN(PI/6) - 1)/(X + TAN(PI/6) + CALL DOATAN ;Compute arctan on argument < PI/12 + MOV SI,OFFSET DC:$SIXTHPI + MOV DI,OFFSET DC:$AC + JMP $SADD ;Correct for range reduction by adding PI/6 + +DOATAN: + MOV BX,OFFSET DC:ATANTAB + JMP $SPOLYX + +CODE ENDS + END From 41eb4a96ca80eae90cb3a355594e7c8ffe63f536 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 11 Jun 2026 17:50:09 -0700 Subject: [PATCH 02/53] Transcription of Bundle 9 - CHAIN.ASM Code and Listing --- 2_printed_files/bundle_09/CHAIN.ASM | 420 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/CHAIN.ASM | 220 +++++++++++++++ 2 files changed, 640 insertions(+) create mode 100644 2_printed_files/bundle_09/CHAIN.ASM create mode 100644 3_source_code/BASLIB-86/CHAIN.ASM diff --git a/2_printed_files/bundle_09/CHAIN.ASM b/2_printed_files/bundle_09/CHAIN.ASM new file mode 100644 index 0000000..287bc8e --- /dev/null +++ b/2_printed_files/bundle_09/CHAIN.ASM @@ -0,0 +1,420 @@ +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Page 1-1 + + + + 1 TITLE CHAIN - CHAIN and RUN statements + 2 + 3 ;Loader for EXE files under 86-DOS + 4 + 5 = 0009 PRINT EQU 9 + 6 = 000F OPEN EQU 15 + 7 = 001A SETDMA EQU 26 + 8 = 0027 RDBLK EQU 39 + 9 = 0029 PARSE EQU 41 + 10 = 0021 RR EQU 33 + 11 = 000E RECLEN EQU 14 + 12 + 13 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 14 EXTRN $EXITSEG:WORD + 15 0000 DATA ENDS + 16 + 17 0000 RUN SEGMENT 'DATA' ;Must be on paragraph boundary + 18 + 19 0000 RUNVAR LABEL BYTE ;Start of RUN variables + 20 0000 ???? RELPT DW ? + 21 0002 ???? RELSEG DW ? + 22 0004 SIZ LABEL WORD ;Share these locations + 23 0004 ???? PAGES DW ? + 24 0006 ???? RELCNT DW ? + 25 0008 ???? HEADSIZ DW ? + 26 000A ???? DW ? + 27 000C ???? LOADLOW DW ? + 28 000E ???? INITSS DW ? + 29 0010 ???? INITSP DW ? + 30 0012 ???? DW ? + 31 0014 ???? INITIP DW ? + 32 0016 ???? INITCS DW ? + 33 0018 ???? RELTAB DW ? + 34 = 001A RUNVARSIZ EQU $-RUNVAR + 35 001A EXEFCBW LABEL WORD + 36 001A 25 [ EXEFCB DB 37 DUP(?) + 37 ?? + 38 ] + 39 + 40 = 0004 DATPARSIZ= ($+13-RUNVAR)/16 + 41 + 42 003F RUN ENDS + 43 + 44 + 45 DC GROUP RUN,DATA + 46 + 47 + 48 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 49 + 50 PUBLIC $RUN,$CHN + 51 + 52 EXTRN $ERR_OM:NEAR, $ERR_FNF:NEAR, $ERR_BFN:NEAR, $$PUTZ:NEAR + 53 + 54 ASSUME CS:CODE, DS:DC, ES:DC + + +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Page 1-2 + + + + 55 + 56 0000 CHAIN PROC FAR + 57 + 58 0000 E9 0000 E BADNAM: JMP $ERR_BFN + 59 0003 E9 0000 E NOFILE: JMP $ERR_FNF + 60 IF1 + 61 CODPARSIZ= 0 ;Sick kludge to save bytes (and generate good code) + 62 ELSE + 63 = 000B CODPARSIZ= (ENDCODE+15-LOAD)/16 + 64 ENDIF + 65 + 66 0006 $CHN: + 67 0006 $RUN: + 68 0006 E8 0000 E CALL $$PUTZ ;Make string terminated by zero + 69 0009 8B 77 02 MOV SI,[BX+2] ;Get address of string data + 70 000C BF 001A R MOV DI,OFFSET DC:EXEFCB ;Place to put resulting FCB + 71 000F B0 01 MOV AL,1 ;Skip leading separators + 72 0011 B4 29 MOV AH,PARSE + 73 0013 CD 21 INT 33 ;Parse file name + 74 0015 0A C0 OR AL,AL ;File name OK? + 75 0017 75 E7 JNZ BADNAM + 76 0019 80 3E 001B R 20 CMP [EXEFCB+1]," " ;File name present? + 77 001E 74 E0 JZ BADNAM + 78 0020 80 3E 0023 R 20 CMP [EXEFCB+9]," " ;Extension present? + 79 0025 75 0B JNZ OPENIT + 80 0027 C7 06 0023 R 5845 MOV [EXEFCBW+9],"XE" + 81 002D C6 06 0025 R 45 MOV [EXEFCB+11],"E" ;If no extension, add default "EXE" + 82 0032 OPENIT: + 83 0032 B4 0F MOV AH,OPEN + 84 0034 BA 001A R MOV DX,OFFSET DC:EXEFCB + 85 0037 CD 21 INT 33 ;Open file + 86 0039 0A C0 OR AL,AL ;File present? + 87 003B 75 C6 JNZ NOFILE + 88 003D 33 C0 XOR AX,AX + 89 003F A3 003B R MOV [EXEFCBW+RR],AX ;Set Random Record field to zero + 90 0042 A3 003D R MOV [EXEFCBW+RR+2],AX + 91 0045 40 INC AX + 92 0046 A3 0028 R MOV [EXEFCBW+RECLEN],AX + 93 0049 EXELOAD: + 94 0049 BA 0000 R MOV DX,OFFSET DC:RUNVAR ;Read header in here + 95 004C B4 1A MOV AH,SETDMA + 96 004E CD 21 INT 33 + 97 0050 B9 001A MOV CX,RUNVARSIZ ;Amount of header info we need + 98 0053 BA 001A R MOV DX,OFFSET DC:EXEFCB + 99 0056 B4 27 MOV AH,RDBLK + 100 0058 CD 21 INT 33 ;Read in header + 101 005A A1 0008 R MOV AX,[HEADSIZ] ;Size of header in paragraphs + 102 ;Convert header size to 512-byte pages by dividing by 32 & rounding up + 103 005D 05 001F ADD AX,31 ;Round up first + 104 0060 B1 05 MOV CL,5 + 105 0062 D3 E8 SHR AX,CL ;Divide by 32 + 106 0064 A3 003B R MOV [EXEFCBW+RR],AX ;Position in file of program + 107 0067 C7 06 0028 R 0200 MOV [EXEFCBW+RECLEN],512 ;Set record size + 108 006D 8B 1E 0000 E MOV BX,[$EXITSEG] + + +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Page 1-3 + + + + 109 0071 83 C3 10 ADD BX,10H ;First paragraph above parameter area + 110 0074 8B 16 0004 R MOV DX,[PAGES] ;Total size of file in 512-byte pages + 111 0078 2B D0 SUB DX,AX ;Size of program in pages + 112 007A 89 16 0004 R MOV [SIZ],DX + 113 007E D3 E2 SHL DX,CL ;Convert pages back to paragraphs + 114 0080 03 D3 ADD DX,BX ;Size + start = minimum memory (paragr.) + 115 0082 8C D1 MOV CX,SS ;Use all memory below stack segment + 116 0084 83 E9 0F SUB CX,DATPARSIZ+CODPARSIZ + 117 0087 3B D1 CMP DX,CX ;Enough memory? + 118 0089 77 26 JA OUTOFMEM + 119 008B 8B EB MOV BP,BX ;Save load segment + 120 + 121 ;Move loader code and data to high end of memory + 122 + 123 008D 8E C1 MOV ES,CX + 124 008F 1E PUSH DS + 125 0090 0E PUSH CS + 126 0091 1F POP DS + 127 0092 BE 00B4 R MOV SI,OFFSET LOAD + 128 0095 33 FF XOR DI,DI + 129 0097 B9 0058 MOV CX,CODPARSIZ*8 ;Size of code in words + 130 009A F3/ A5 REP MOVSW + 131 009C 1F POP DS + 132 009D BE 0000 R MOV SI,OFFSET DC:RUNVAR + 133 00A0 B9 0020 MOV CX,DATPARSIZ*8 + 134 00A3 F3/ A5 REP MOVSW + 135 00A5 33 C0 XOR AX,AX + 136 00A7 06 PUSH ES + 137 00A8 50 PUSH AX ;Fake a return address + 138 00A9 8C C0 MOV AX,ES + 139 00AB 05 000B ADD AX,CODPARSIZ + 140 00AE 8E D8 MOV DS,AX + 141 00B0 CB RET ;Transfer control to loader at end of memory + 142 + 143 00B1 E9 0000 E OUTOFMEM:JMP $ERR_OM + 144 + 145 ASSUME DS:RUN + 146 + 147 00B4 LOAD: + 148 00B4 1E PUSH DS + 149 00B5 8E DB MOV DS,BX + 150 00B7 33 D2 XOR DX,DX ;Address 0 in segment + 151 00B9 B4 1A MOV AH,SETDMA + 152 00BB CD 21 INT 33 ;Set load address + 153 00BD 1F POP DS + 154 00BE 8B 0E 0004 R MOV CX,[SIZ] ;Maximum record count (512 bytes ea) + 155 00C2 BA 001A R MOV DX,OFFSET EXEFCB + 156 00C5 B4 27 MOV AH,RDBLK + 157 00C7 CD 21 INT 33 ;Read in up to 64K + 158 00C9 29 0E 0004 R SUB [SIZ],CX ;Decrement count by amount read + 159 00CD 74 0A JZ HAVEXE ;Did weget it all? + 160 00CF A8 01 TEST AL,1 ;Check return code if not + 161 00D1 75 66 JNZ BADEXE ;Must be zero if more to come + 162 00D3 81 C3 0FE0 ADD BX,1000H-20H ;Bump data segment 64K + + +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Page 1-4 + + + + 163 00D7 EB DB JMP LOAD ;Get next 64K block + 164 + 165 00D9 HAVEXE: + 166 00D9 A1 0018 R MOV AX,[RELTAB] ;Get position of table + 167 00DC A3 003B R MOV [EXEFCBW+RR],AX ;Set in random record field + 168 00DF C7 06 0028 R 0001 MOV [EXEFCBW+RECLEN],1 ;Set one-byte record + 169 00E5 BA 0000 R MOV DX,OFFSET RELPT ;4-byte buffer for relocation address + 170 00E8 B4 1A MOV AH,SETDMA + 171 00EA CD 21 INT 33 + 172 00EC 83 3E 0006 R 00 CMP [RELCNT],0 ;Any fixups to do? + 173 00F1 74 22 JZ NOREL + 174 00F3 RELOC: + 175 00F3 B4 27 MOV AH,RDBLK + 176 00F5 BA 001A R MOV DX,OFFSET EXEFCB + 177 00F8 B9 0004 MOV CX,4 + 178 00FB CD 21 INT 33 ;Read in one relocation pointer + 179 00FD 0A C0 OR AL,AL ;Check return code + 180 00FF 75 38 JNZ BADEXE + 181 0101 8B 3E 0000 R MOV DI,[RELPT] ;Get offset of relocation pointer + 182 0105 A1 0002 R MOV AX,[RELSEG] ;Get segment + 183 0108 03 C5 ADD AX,BP ;Bias segment with actual load segment + 184 010A 8E C0 MOV ES,AX + 185 010C 26: 01 2D ADD ES:[DI],BP ;Relocate + 186 010F FF 0E 0006 R DEC [RELCNT] ;Count off + 187 0113 75 DE JNZ RELOC + 188 0115 NOREL: + 189 0115 A1 000E R MOV AX,[INITSS] + 190 0118 03 C5 ADD AX,BP + 191 011A 8E D0 MOV SS,AX ;Initialize SS + 192 011C 8B 26 0010 R MOV SP,[INITSP] + 193 0120 A1 0016 R MOV AX,[INITCS] + 194 0123 03 C5 ADD AX,BP + 195 0125 50 PUSH AX + 196 0126 FF 36 0014 R PUSH [INITIP] + 197 012A 83 ED 10 SUB BP,10H ;Point back to parameter area + 198 012D 8E C5 MOV ES,BP + 199 012F 8E DD MOV DS,BP ;Set segment registers to point to it + 200 0131 BA 0080 MOV DX,80H + 201 0134 B4 1A MOV AH,SETDMA + 202 0136 CD 21 INT 33 ;Set default disk transfer address + 203 0138 CB RET + 204 + 205 0139 BADEXE: + 206 0139 0E PUSH CS + 207 013A 1F POP DS + 208 013B BA 014A R MOV DX,OFFSET EXEBAD + 209 013E B4 09 MOV AH,PRINT + 210 0140 CD 21 INT 33 + 211 0142 83 ED 10 SUB BP,10H + 212 0145 55 PUSH BP + 213 0146 33 C0 XOR AX,AX + 214 0148 50 PUSH AX + 215 0149 CB RET + 216 + + +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Page 1-5 + + + + 217 014A 0D 0A 45 72 72 6F EXEBAD DB 13,10,"Error in EXE file",13,10,"$" + 218 72 20 69 6E 20 45 + 219 58 45 20 66 69 6C + 220 65 0D 0A 24 + 221 + 222 0160 ENDCODE: + 223 + 224 0160 CHAIN ENDP + 225 0160 CODE ENDS + 226 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0160 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + RUN. . . . . . . . . . . . . . . 003F PARA NONE 'DATA' + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BADEXE . . . . . . . . . . . . . L NEAR 0139 CODE +BADNAM . . . . . . . . . . . . . L NEAR 0000 CODE +CHAIN. . . . . . . . . . . . . . F PROC 0000 CODE Length =0160 +CODPARSIZ. . . . . . . . . . . . Number 000B +DATPARSIZ. . . . . . . . . . . . Number 0004 +ENDCODE. . . . . . . . . . . . . L NEAR 0160 CODE +EXEBAD . . . . . . . . . . . . . L BYTE 014A CODE +EXEFCB . . . . . . . . . . . . . L BYTE 001A RUN Length =0025 +EXEFCBW. . . . . . . . . . . . . L WORD 001A RUN +EXELOAD. . . . . . . . . . . . . L NEAR 0049 CODE +HAVEXE . . . . . . . . . . . . . L NEAR 00D9 CODE +HEADSIZ. . . . . . . . . . . . . L WORD 0008 RUN +INITCS . . . . . . . . . . . . . L WORD 0016 RUN +INITIP . . . . . . . . . . . . . L WORD 0014 RUN +INITSP . . . . . . . . . . . . . L WORD 0010 RUN +INITSS . . . . . . . . . . . . . L WORD 000E RUN +LOAD . . . . . . . . . . . . . . L NEAR 00B4 CODE +LOADLOW. . . . . . . . . . . . . L WORD 000C RUN +NOFILE . . . . . . . . . . . . . L NEAR 0003 CODE +NOREL. . . . . . . . . . . . . . L NEAR 0115 CODE +OPEN . . . . . . . . . . . . . . Number 000F +OPENIT . . . . . . . . . . . . . L NEAR 0032 CODE +OUTOFMEM . . . . . . . . . . . . L NEAR 00B1 CODE +PAGES. . . . . . . . . . . . . . L WORD 0004 RUN +PARSE. . . . . . . . . . . . . . Number 0029 +PRINT. . . . . . . . . . . . . . Number 0009 +RDBLK. . . . . . . . . . . . . . Number 0027 +RECLEN . . . . . . . . . . . . . Number 000E +RELCNT . . . . . . . . . . . . . L WORD 0006 RUN +RELOC. . . . . . . . . . . . . . L NEAR 00F3 CODE +RELPT. . . . . . . . . . . . . . L WORD 0000 RUN +RELSEG . . . . . . . . . . . . . L WORD 0002 RUN +RELTAB . . . . . . . . . . . . . L WORD 0018 RUN +RR . . . . . . . . . . . . . . . Number 0021 +RUNVAR . . . . . . . . . . . . . L BYTE 0000 RUN +RUNVARSIZ. . . . . . . . . . . . Number 001A +SETDMA . . . . . . . . . . . . . Number 001A +SIZ. . . . . . . . . . . . . . . L WORD 0004 RUN +$$PUTZ . . . . . . . . . . . . . L NEAR 0000 CODE External +$CHN . . . . . . . . . . . . . . L NEAR 0006 CODE Global +$ERR_BFN . . . . . . . . . . . . L NEAR 0000 CODE External + + +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Symbols-1 + + + +$ERR_FNF . . . . . . . . . . . . L NEAR 0000 CODE External +$ERR_OM. . . . . . . . . . . . . L NEAR 0000 CODE External +$EXITSEG . . . . . . . . . . . . V WORD 0000 DATA External +$RUN . . . . . . . . . . . . . . L NEAR 0006 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/CHAIN.ASM b/3_source_code/BASLIB-86/CHAIN.ASM new file mode 100644 index 0000000..7b673e9 --- /dev/null +++ b/3_source_code/BASLIB-86/CHAIN.ASM @@ -0,0 +1,220 @@ + TITLE CHAIN - CHAIN and RUN statements + +;Loader for EXE files under 86-DOS + +PRINT EQU 9 +OPEN EQU 15 +SETDMA EQU 26 +RDBLK EQU 39 +PARSE EQU 41 +RR EQU 33 +RECLEN EQU 14 + +DATA SEGMENT WORD PUBLIC 'DATA' + EXTRN $EXITSEG:WORD +DATA ENDS + +RUN SEGMENT 'DATA' ;Must be on paragraph boundary + +RUNVAR LABEL BYTE ;Start of RUN variables +RELPT DW ? +RELSEG DW ? +SIZ LABEL WORD ;Share these locations +PAGES DW ? +RELCNT DW ? +HEADSIZ DW ? + DW ? +LOADLOW DW ? +INITSS DW ? +INITSP DW ? + DW ? +INITIP DW ? +INITCS DW ? +RELTAB DW ? +RUNVARSIZ EQU $-RUNVAR +EXEFCBW LABEL WORD +EXEFCB DB 37 DUP(?) +DATPARSIZ= ($+13-RUNVAR)/16 + +RUN ENDS + + +DC GROUP RUN,DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $RUN,$CHN + + EXTRN $ERR_OM:NEAR, $ERR_FNF:NEAR, $ERR_BFN:NEAR, $$PUTZ:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +CHAIN PROC FAR + +BADNAM: JMP $ERR_BFN +NOFILE: JMP $ERR_FNF + IF1 +CODPARSIZ= 0 ;Sick kludge to save bytes (and generate good code) + ELSE +CODPARSIZ= (ENDCODE+15-LOAD)/16 + ENDIF + +$CHN: +$RUN: + CALL $$PUTZ ;Make string terminated by zero + MOV SI,[BX+2] ;Get address of string data + MOV DI,OFFSET DC:EXEFCB ;Place to put resulting FCB + MOV AL,1 ;Skip leading separators + MOV AH,PARSE + INT 33 ;Parse file name + OR AL,AL ;File name OK? + JNZ BADNAM + CMP [EXEFCB+1]," " ;File name present? + JZ BADNAM + CMP [EXEFCB+9]," " ;Extension present? + JNZ OPENIT + MOV [EXEFCBW+9],"XE" + MOV [EXEFCB+11],"E" ;If no extension, add default "EXE" +OPENIT: + MOV AH,OPEN + MOV DX,OFFSET DC:EXEFCB + INT 33 ;Open file + OR AL,AL ;File present? + JNZ NOFILE + XOR AX,AX + MOV [EXEFCBW+RR],AX ;Set Random Record field to zero + MOV [EXEFCBW+RR+2],AX + INC AX + MOV [EXEFCBW+RECLEN],AX +EXELOAD: + MOV DX,OFFSET DC:RUNVAR ;Read header in here + MOV AH,SETDMA + INT 33 + MOV CX,RUNVARSIZ ;Amount of header info we need + MOV DX,OFFSET DC:EXEFCB + MOV AH,RDBLK + INT 33 ;Read in header + MOV AX,[HEADSIZ] ;Size of header in paragraphs +;Convert header size to 512-byte pages by dividing by 32 & rounding up + ADD AX,31 ;Round up first + MOV CL,5 + SHR AX,CL ;Divide by 32 + MOV [EXEFCBW+RR],AX ;Position in file of program + MOV [EXEFCBW+RECLEN],512 ;Set record size + MOV BX,[$EXITSEG] + ADD BX,10H ;First paragraph above parameter area + MOV DX,[PAGES] ;Total size of file in 512-byte pages + SUB DX,AX ;Size of program in pages + MOV [SIZ],DX + SHL DX,CL ;Convert pages back to paragraphs + ADD DX,BX ;Size + start = minimum memory (paragr.) + MOV CX,SS ;Use all memory below stack segment + SUB CX,DATPARSIZ+CODPARSIZ + CMP DX,CX ;Enough memory? + JA OUTOFMEM + MOV BP,BX ;Save load segment + +;Move loader code and data to high end of memory + + MOV ES,CX + PUSH DS + PUSH CS + POP DS + MOV SI,OFFSET LOAD + XOR DI,DI + MOV CX,CODPARSIZ*8 ;Size of code in words + REP MOVSW + POP DS + MOV SI,OFFSET DC:RUNVAR + MOV CX,DATPARSIZ*8 + REP MOVSW + XOR AX,AX + PUSH ES + PUSH AX ;Fake a return address + MOV AX,ES + ADD AX,CODPARSIZ + MOV DS,AX + RET ;Transfer control to loader at end of memory + +OUTOFMEM:JMP $ERR_OM + + ASSUME DS:RUN + +LOAD: + PUSH DS + MOV DS,BX + XOR DX,DX ;Address 0 in segment + MOV AH,SETDMA + INT 33 ;Set load address + POP DS + MOV CX,[SIZ] ;Maximum record count (512 bytes ea) + MOV DX,OFFSET EXEFCB + MOV AH,RDBLK + INT 33 ;Read in up to 64K + SUB [SIZ],CX ;Decrement count by amount read + JZ HAVEXE ;Did we get it all? + TEST AL,1 ;Check return code if not + JNZ BADEXE ;Must be zero if more to come + ADD BX,1000H-20H ;Bump data segment 64K + JMP LOAD ;Get next 64K block + +HAVEXE: + MOV AX,[RELTAB] ;Get position of table + MOV [EXEFCBW+RR],AX ;Set in random record field + MOV [EXEFCBW+RECLEN],1 ;Set one-byte record + MOV DX,OFFSET RELPT ;4-byte buffer for relocation address + MOV AH,SETDMA + INT 33 + CMP [RELCNT],0 ;Any fixups to do? + JZ NOREL +RELOC: + MOV AH,RDBLK + MOV DX,OFFSET EXEFCB + MOV CX,4 + INT 33 ;Read in one relocation pointer + OR AL,AL ;Check return code + JNZ BADEXE + MOV DI,[RELPT] ;Get offset of relocation pointer + MOV AX,[RELSEG] ;Get segment + ADD AX,BP ;Bias segment with actual load segment + MOV ES,AX + ADD ES:[DI],BP ;Relocate + DEC [RELCNT] ;Count off + JNZ RELOC +NOREL: + MOV AX,[INITSS] + ADD AX,BP + MOV SS,AX ;Initialize SS + MOV SP,[INITSP] + MOV AX,[INITCS] + ADD AX,BP + PUSH AX + PUSH [INITIP] + SUB BP,10H ;Point back to parameter area + MOV ES,BP + MOV DS,BP ;Set segment registers to point to it + MOV DX,80H + MOV AH,SETDMA + INT 33 ;Set default disk transfer address + RET + +BADEXE: + PUSH CS + POP DS + MOV DX,OFFSET EXEBAD + MOV AH,PRINT + INT 33 + SUB BP,10H + PUSH BP + XOR AX,AX + PUSH AX + RET + +EXEBAD DB 13,10,"Error in EXE file",13,10,"$" + +ENDCODE: + +CHAIN ENDP +CODE ENDS + END From ca35977e60d85660505368dc59b42332f2c769ac Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 11 Jun 2026 17:53:09 -0700 Subject: [PATCH 03/53] Fixed data entry error in CHAIN.ASM Listing --- 2_printed_files/bundle_09/CHAIN.ASM | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/2_printed_files/bundle_09/CHAIN.ASM b/2_printed_files/bundle_09/CHAIN.ASM index 287bc8e..b6ed524 100644 --- a/2_printed_files/bundle_09/CHAIN.ASM +++ b/2_printed_files/bundle_09/CHAIN.ASM @@ -358,7 +358,7 @@ $CHN . . . . . . . . . . . . . . L NEAR 0006 CODE Global $ERR_BFN . . . . . . . . . . . . L NEAR 0000 CODE External -CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Symbols-1 +CHAIN - CHAIN and RUN statements Macro-86 %1(12) 0:58:26 13-Nov-81 Symbols-2 From f0beb9101a7f3696eaa9a59238cb57258aaf00dd Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 12 Jun 2026 16:30:30 -0700 Subject: [PATCH 04/53] Transcription of Bundle 9 - CONASC.ASM Code and Listing --- 2_printed_files/bundle_09/CONASC.ASM | 600 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/CONASC.ASM | 418 +++++++++++++++++++ 2 files changed, 1018 insertions(+) create mode 100644 2_printed_files/bundle_09/CONASC.ASM create mode 100644 3_source_code/BASLIB-86/CONASC.ASM diff --git a/2_printed_files/bundle_09/CONASC.ASM b/2_printed_files/bundle_09/CONASC.ASM new file mode 100644 index 0000000..4ce8546 --- /dev/null +++ b/2_printed_files/bundle_09/CONASC.ASM @@ -0,0 +1,600 @@ +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-1 + + + 1 TITLE CONASC - Convert number to ASCII + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 PUBLIC SIGN,FOBUF + 6 + 7 EXTRN VALTYP:BYTE, $FAC:BYTE, $AC:BYTE, $DAC:BYTE + 8 + 9 0000 ?? SIGN DB ? + 10 0001 23 [ FOBUF DB 35 DUP (?) ;Numeric output buffer + 11 ?? + 12 ] + 13 + 14 0024 14 [ BUF DB 20 DUP (?) ;ASCII conversion buffer + 15 ?? + 16 ] + 17 + 18 + 19 0038 DATA ENDS + 20 + 21 + 22 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 23 + 24 EXTRN PWR10TAB:WORD + 25 + 26 ; Table of integers 10^X, for X=18 down to 8, for converting DP numbers + 27 + 28 0000 DPCON LABEL WORD + 29 0000 0000 A764 B6B3 0DE0 DW 0000H,0A764H,0B6B3H,0DE0H ;10^18 + 30 0008 0000 5D8A 4578 0163 DW 0000H,5D8AH,4578H,163H ;10^17 + 31 0010 0000 6FC1 86F2 0023 DW 0000H,6FC1H,86F2H,23H ;10^16 + 32 0018 8000 A4C6 8D7E 0003 DW 8000H,0A4C6H,8D7EH,3 ;10^15 + 33 0020 4000 107A 5AF3 0000 DW 4000H,107AH,5AF3H,0 ;10^14 + 34 0028 A000 4E72 0918 0000 DW 0A000H,4E72H,918H,0 ;10^13 + 35 0030 1000 D4A5 00E8 0000 DW 1000H,0D4A5H,0E8H,0 ;10^12 + 36 0038 E800 4876 0017 0000 DW 0E800H,4876H,17H,0 ;10^11 + 37 0040 E400 540B 0002 0000 DW 0E400H,540BH,2,0 ;10^10 + 38 0048 CA00 3B9A 0000 0000 DW 0CA00H,3B9AH,0,0 ;10^9 + 39 0050 E100 05F5 0000 0000 DW 0E100H,5F5H,0,0 ;10^8 + 40 + 41 + 42 ;EXPTAB - Lookup table for exponents + 43 ;An actual base 2 exponent of 25 or 57 (for SP or DP, respectively) is needed + 44 ;before a number may be converted from binary to decimal. This is because such + 45 ;an exponent ensures the mantissa is just a big integer. The difference + 46 ;between the desired exponent (25 or 57) and the present one is figured and + 47 ;used as an index into this table. The entries in the table represent the + 48 ;power of 10 to multiply by to get the needed exponent. The table covers + 49 ;an exponent difference range of -102 [25-127] to +184 [57-(-127)]. + 50 + 51 0058 E2 E2 E2 E3 E3 E3 DB -30,-30,-30,-29,-29,-29 ;-102 to -97 + 52 005E E4 E4 E4 E5 E5 E5 DB -28,-28,-28,-27,-27,-27,-27,-26 ;-96 to -89 + 53 E5 E6 + 54 0066 E6 E6 E7 E7 E7 E8 DB -26,-26,-25,-25,-25,-24,-24,-24 ;-88 to -81 + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-2 + + + + 55 E8 E8 + 56 006E E8 E9 E9 E9 EA EA DB -24,-23,-23,-23,-22,-22,-22,-21 ;-80 to -73 + 57 EA EB + 58 0076 EB EB EB EC EC EC DB -21,-21,-21,-20,-20,-20,-19,-19 ;-72 to -65 + 59 ED ED + 60 007E ED EE EE EE EE EF DB -19,-18,-18,-18,-18,-17,-17,-17 ;-64 to -57 + 61 EF EF + 62 0086 F0 F0 F0 F1 F1 F1 DB -16,-16,-16,-15,-15,-15,-15,-14 ;-56 to -49 + 63 F1 F2 + 64 008E F2 F2 F3 F3 F3 F4 DB -14,-14,-13,-13,-13,-12,-12,-12 ;-48 to -41 + 65 F4 F4 + 66 0096 F4 F5 F5 F5 F6 F6 DB -12,-11,-11,-11,-10,-10,-10,-9 ;-40 to -33 + 67 F6 F7 + 68 009E F7 F7 F7 F8 F8 F8 DB -9,-9,-9,-8,-8,-8,-7,-7 ;-32 to -25 + 69 F9 F9 + 70 00A6 F9 FA FA FA FA FB DB -7,-6,-6,-6,-6,-5,-5,-5 ;-24 to -17 + 71 FB FB + 72 00AE FC FC FC FD FD FD DB -4,-4,-4,-3,-3,-3,-3,-2 ;-16 to -9 + 73 FD FE + 74 00B6 FE FE FF FF FF 00 DB -2,-2,-1,-1,-1,0,0,0 ;-8 to -1 + 75 00 00 + 76 00BE EXPTAB LABEL BYTE ;Table is centered on zero + 77 00BE 00 01 01 01 02 02 DB 0,1,1,1,2,2,2,3 ;0 to 7 + 78 02 03 + 79 00C6 03 03 04 04 04 04 DB 3,3,4,4,4,4,5,5 ;8 to 15 + 80 05 05 + 81 00CE 05 06 06 06 07 07 DB 5,6,6,6,7,7,7,7 ;16 to 23 + 82 07 07 + 83 00D6 08 08 08 09 09 09 DB 8,8,8,9,9,9,10,10 ;24 to 31 + 84 0A 0A + 85 00DE 0A 0A 0B 0B 0B 0C DB 10,10,11,11,11,12,12,12 ;32 to 39 + 86 0C 0C + 87 00E6 0D 0D 0D 0D 0E 0E DB 13,13,13,13,14,14,14,15 ;40 to 47 + 88 0E 0F + 89 00EE 0F 0F 10 10 10 10 DB 15,15,16,16,16,16,17,17 ;48 to 55 + 90 11 11 + 91 00F6 11 12 12 12 13 13 DB 17,18,18,18,19,19,19,19 ;56 to 63 + 92 13 13 + 93 00FE 14 14 14 15 15 15 DB 20,20,20,21,21,21,22,22 ;64 to 71 + 94 16 16 + 95 0106 16 16 17 17 17 18 DB 22,22,23,23,23,24,24,24 ;72 to 79 + 96 18 18 + 97 010E 19 19 19 19 1A 1A DB 25,25,25,25,26,26,26,27 ;80 to 87 + 98 1A 1B + 99 0116 1B 1B 1C 1C 1C 1C DB 27,27,28,28,28,28,29,29 ;88 to 95 + 100 1D 1D + 101 011E 1D 1E 1E 1E 1F 1F DB 29,30,30,30,31,31,31,32 ;96 to 103 + 102 1F 20 + 103 0126 20 20 20 21 21 21 DB 32,32,32,33,33,33,34,34 ;104 to 111 + 104 22 22 + 105 012E 22 23 23 23 23 24 DB 34,35,35,35,35,36,36,36 ;112 to 119 + 106 24 24 + 107 0136 25 25 25 26 26 26 DB 37,37,37,38,38,38,38,39 ;120 to 127 + 108 26 27 + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-3 + + + + 109 013E 27 27 28 28 28 29 DB 39,39,40,40,40,41,41,41 ;128 to 135 + 110 29 29 + 111 0146 29 2A 2A 2A 2B 2B DB 41,42,42,42,43,43,43,44 ;136 to 143 + 112 2B 2C + 113 014E 2C 2C 2C 2D 2D 2D DB 44,44,44,45,45,45,46,46 ;144 to 151 + 114 2E 2E + 115 0156 2E 2F 2F 2F 2F 30 DB 46,47,47,47,47,48,48,48 ;152 to 159 + 116 30 30 + 117 015E 31 31 31 32 32 32 DB 49,49,49,50,50,50,50,51 ;160 to 167 + 118 32 33 + 119 0166 33 33 34 34 34 35 DB 51,51,52,52,52,53,53,53 ;168 to 175 + 120 35 35 + 121 016E 35 36 36 36 37 37 DB 53,54,54,54,55,55,55,56 ;176 to 183 + 122 37 38 + 123 0176 38 DB 56 ;184 + 124 + 125 0177 CONST ENDS + 126 + 127 DC GROUP CONST,DATA + 128 + 129 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 130 + 131 PUBLIC CONASC, ASCRND, $TYPUI + 132 + 133 EXTRN PMULS:NEAR, PMULD:NEAR + 134 EXTRN $$WCHT:NEAR + 135 + 136 ASSUME CS:CODE, DS:DC, ES:DC + 137 + 138 + 139 0000 OUTINT: ;This is a continuation of CONASC, below + 140 0000 BF 0024 R MOV DI,OFFSET DC:BUF ;Save digits in BUF + 141 0003 A1 0000 E MOV AX,WORD PTR[$AC] ;Get integer to convert + 142 0006 B2 20 MOV DL," " ;In case sign is positive + 143 0008 0B C0 OR AX,AX + 144 000A 74 12 JZ ZERO + 145 000C 79 04 JNS SAVSGN ;Positive? + 146 000E F7 D8 NEG AX ;Force in positive + 147 0010 B2 2D MOV DL,"-" + 148 0012 SAVSGN: + 149 0012 88 16 0000 R MOV [SIGN],DL ;Record the sign + 150 0016 E8 0163 R CALL ASCINT ;Convert it to ASCII + 151 0019 B2 00 MOV DL,0 ;Base 10 exponent is zero + 152 001B E9 00D7 R JMP COUNTDIG + 153 + 154 001E ZERO: + 155 001E C6 06 0000 R 20 MOV [SIGN]," " ;Show positive sign + 156 0023 B9 0001 MOV CX,1 ;Only one digit + 157 0026 B2 00 MOV DL,0 ;Zero base 10 exponent + 158 0028 BE 0024 R MOV SI,OFFSET DC:BUF + 159 002B C6 04 30 MOV BYTE PTR [SI],"0" + 160 002E C3 RET + 161 + 162 + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-4 + + + + 163 ;*** CONASC - Convert number to ASCII + 164 ; + 165 ; Inputs: + 166 ; $AC has integer or SP number OR $DAC has DP number + 167 ; VALTYP has type (2=integer, 4=SP, 8=DP) + 168 ; Function: + 169 ; Convert number to a string of ASCII digits with no leading or + 170 ; trailing zeros. Return base 10 exponent and count of digits. + 171 ; Outputs: + 172 ; CX = number of significant figures (decimal point to right) + 173 ; DL = base 10 exponent + 174 ; SI = Address of first digit (non-zero unless number is zero) + 175 ; [SIGN] has sign - blank if positive, "-" if negative + 176 ; Registers: + 177 ; Uses all. + 178 + 179 002F CONASC: + 180 002F 80 3E 0000 E 04 CMP [VALTYP],4 ;Check type of number + 181 0034 72 CA JB OUTINT + 182 0036 BB 0099 MOV BX,25+128 ;Desired exponent for SP (plus bias) + 183 0039 74 03 JZ FIGDIF ;SP number? + 184 003B 83 C3 20 ADD BX,32 ;32 bits more for DP + 185 003E FIGDIF: + 186 003E 8A 16 0000 E MOV DL,[$FAC] ;Get exponent + 187 0042 0A D2 OR DL,DL ;Is number zero? + 188 0044 74 D8 JZ ZERO ;That was easy + 189 0046 B6 00 MOV DH,0 + 190 0048 2B DA SUB BX,DX ;See what we have to do to get desired exp. + 191 004A B0 20 MOV AL," " ;In case its positive + 192 004C F6 06 FFFF E 80 TEST [$FAC-1],80H ;Check sign bit + 193 0051 74 02 JZ SETSGN ;Positive? + 194 0053 B0 2D MOV AL,"-" + 195 0055 SETSGN: + 196 0055 A2 0000 R MOV [SIGN],AL + 197 0058 8A 87 00BE R MOV AL,OFFSET DC:EXPTAB[BX] ;What power of 10 will give us the right exp? + 198 005C 98 CBW + 199 005D 8B F0 MOV SI,AX + 200 005F D1 E6 SHL SI,1 ;8 bytes per entry in power of 10 table + 201 0061 D1 E6 SHL SI,1 + 202 0063 D1 E6 SHL SI,1 + 203 0065 81 C6 0000 E ADD SI,OFFSET DC:PWR10TAB + 204 0069 8A 64 07 MOV AH,[SI+7] ;Get base 2 exponent of this power of 10 + 205 006C 02 E2 ADD AH,DL ;Compute exponent resulting from multiply + 206 006E F6 D8 NEG AL ;Take account of multiplying by power of 10 + 207 0070 50 PUSH AX ;Save base 2 and base 10 exponents + 208 0071 80 3E 0000 E 04 CMP [VALTYP],4 ;SP number? + 209 0076 75 6F JNZ OUTDBL ;If not, go do double precision calculations + 210 0078 8B 3E 0000 E MOV DI,WORD PTR[$AC] ;Load up number to convert + 211 007C 8A 0E 0002 E MOV CL,[$AC+2] + 212 0080 8A 5C 06 MOV BL,[SI+6] ;Load up power of 10 + 213 0083 8A 44 03 MOV AL,BYTE PTR[SI+3] ;Get byte below least significant + 214 0086 80 C9 80 OR CL,80H ;Set im plied bit + 215 0089 F6 E1 MUL CL ;Compute least significant partial product + 216 008B 8B 74 04 MOV SI,[SI+4] + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-5 + + + + 217 008E 50 PUSH AX + 218 008F E8 0000 E CALL PMULS ;Multiply mantissas - result in AX:BX + 219 0092 5A POP DX ;Retrieve least significant partial product + 220 0093 02 DE ADD BL,DH ;Accumulate it + 221 0095 80 D7 00 ADC BH,0 + 222 0098 15 0000 ADC AX,0 + 223 009B B6 00 MOV DH,0 ;Shuffle to get result in DX:AL:BL + 224 009D 8A D4 MOV DL,AH + 225 009F 8A E0 MOV AH,AL + 226 00A1 8A C7 MOV AL,BH + 227 00A3 59 POP CX ;Recover base 2 exponent + 228 00A4 51 PUSH CX + 229 00A5 86 CD XCHG CL,CH ;Base 2 exponent in CL + 230 00A7 81 E1 0007 AND CX,7 ;We'll be within 4 of desired exponent + 231 00AB 74 08 JZ RNDTST ;Hit it exactly? + 232 ;Exponent did not turn out to be exactly 24 - it could be as much as 29. + 233 ;For every power of two larger, we must shift another bit into the mantissa, + 234 ;so that when we're done we have the same number of bits as the exponent says. + 235 00AD SHFT: + 236 00AD D0 E3 SHL BL,1 + 237 00AF D1 D0 RCL AX,1 + 238 00B1 D1 D2 RCL DX,1 + 239 00B3 E2 F8 LOOP SHFT + 240 00B5 RNDTST: + 241 00B5 BF 0024 R MOV DI,OFFSET DC:BUF ;Save characters in BUF + 242 00B8 80 FB 80 CMP BL,80H ;Do we need to round? + 243 00BB 77 06 JA ROUND ;Yes + 244 00BD 72 0A JB ASCSP ;No + 245 00BF A8 01 TEST AL,1 ;Maybe - round even + 246 00C1 74 06 JZ ASCSP + 247 00C3 ROUND: + 248 00C3 05 0001 ADD AX,1 ;Round up + 249 00C6 83 D2 00 ADC DX,0 ;Propagate carry + 250 00C9 ASCSP: + 251 00C9 BB 2710 MOV BX,10000 ;Break number in to 2 manageable chunks + 252 00CC F7 F3 DIV BX + 253 00CE 52 PUSH DX ;Save low half for later + 254 00CF E8 0163 R CALL ASCINT ;Convert high 5 digits + 255 00D2 5A POP DX + 256 00D3 E8 0173 R CALL ASC10K ;Convert last 4 digits + 257 00D6 5A POP DX ;DL = base 10 exponent + 258 00D7 COUNTDIG: + 259 00D7 8B CF MOV CX,DI + 260 00D9 BF 0024 R MOV DI,OFFSET DC:BUF + 261 00DC 2B CF SUB CX,DI ;Number of digits converted + 262 00DE B0 30 MOV AL,"0" + 263 00E0 F3/ AE REPE SCASB ;Scan off leading zeros + 264 00E2 41 INC CX ;Number of digits left + 265 00E3 4F DEC DI ;Point to first digit + 266 00E4 8B F7 MOV SI,DI + 267 00E6 C3 RET + 268 + 269 00E7 OUTDBL: + 270 00E7 BF 0000 E MOV DI,OFFSET DC:$DAC + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-6 + + + + 271 00EA E8 0000 E CALL PMULD ;Result in DI:BX:CX:DX + 272 00ED 8A C5 MOV AL,CH ;Get result in BX:BP:DI:AX:DL + 273 00EF 8A E3 MOV AH,BL + 274 00F1 97 XCHG AX,DI + 275 00F2 8A DC MOV BL,AH + 276 00F4 8A E0 MOV AH,AL + 277 00F6 8A C7 MOV AL,BH + 278 00F8 95 XCHG AX,BP + 279 00F9 B7 00 MOV BH,0 + 280 00FB 8A C6 MOV AL,DH + 281 00FD 8A E1 MOV AH,CL + 282 00FF 59 POP CX ;Recover base 2 exponent + 283 0100 51 PUSH CX + 284 0101 86 CD XCHG CL,CH ;Base 2 exponent in CL + 285 0103 81 E1 0007 AND CX,7 ;We'll be within 4 of desired exponent + 286 0107 74 0C JZ DRNDTST ;Hit it exactly? + 287 ;Exponent did not turn out to be exactly 56 - it could be as much as 61. + 288 ;For every power of two larger, we must shift another bit into the mantissa, + 289 ;so that when we're done we have the sa me number of bits as the exponent says. + 290 0109 DSHFT: + 291 0109 D0 E2 SHL DL,1 + 292 010B D1 D0 RCL AX,1 + 293 010D D1 D7 RCL DI,1 + 294 010F D1 D5 RCL BP,1 + 295 0111 D1 D3 RCL BX,1 + 296 0113 E2 F4 LOOP DSHFT + 297 0115 DRNDTST: + 298 0115 80 FA 80 CMP DL,80H ;Need to round? + 299 0118 77 06 JA DROUND ;Yes + 300 011A 72 10 JB DPCONV ;No + 301 011C A8 01 TEST AL,1 ;Maybe - round even + 302 011E 74 0C JZ DPCONV + 303 0120 DROUND: + 304 0120 05 0001 ADD AX,1 + 305 0123 83 D7 00 ADC DI,0 + 306 0126 83 D5 00 ADC BP,0 + 307 0129 83 D3 00 ADC BX,0 + 308 012C DPCONV: + 309 012C 8B D7 MOV DX,DI ;Number now in BX:BP:DX:AX + 310 012E BF 0024 R MOV DI,OFFSET DC:BUF ;Save characters in BUF + 311 0131 B9 000B MOV CX,11 ;19 digits - last 8 handled by SP converter + 312 0134 BE 0000 R MOV SI,OFFSET DC:DPCON ;Table of powers of 10 + 313 0137 DPDIG: + 314 0137 2B 04 SUB AX,[SI] ;Subtract a power of 10 + 315 0139 1B 54 02 SBB DX,[SI+2] + 316 013C 1B 6C 04 SBB BP,[SI+4] + 317 013F 1B 5C 06 SBB BX,[SI+6] + 318 0142 FE C5 INC CH ;Count in case successful + 319 0144 73 F1 JNC DPDIG ;Divide by 10^X by repeat subtraction + 320 ;We subtracted one too many, so restore + 321 0146 03 04 ADD AX,[SI] + 322 0148 13 54 02 ADC DX,[SI+2] + 323 014B 13 6C 04 ADC BP,[SI+4] + 324 014E 13 5C 06 ADC BX,[SI+6] + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-7 + + + + 325 0151 FE CD DEC CH + 326 0153 83 C6 08 ADD SI,8 ;Bump up to next power of 10 + 327 0156 80 CD 30 OR CH,"0" + 328 0159 88 2D MOV [DI],CH ;Store the digit + 329 015B 47 INC DI + 330 015C B5 00 MOV CH,0 ;Initialize count for next power of 10 + 331 015E E2 D7 LOOP DPDIG + 332 ;What we have left now is a number in DX:AX < 10^8 + 333 0160 E9 00C9 R JMP ASCSP + 334 + 335 + 336 ;*** ASCINT = Convert 2-byte integer to ASCII + 337 ; + 338 ; Inputs: + 339 ; AX = integer + 340 ; DI = pointer to digit buffer + 341 ; Function: + 342 ; Convert the integer to 5 unpacked BCD digits, stored at [DI]. + 343 ; Outputs: + 344 ; None. + 345 ; Registers: + 346 ; All destroyed. + 347 + 348 0163 ASCINT: + 349 0163 33 D2 XOR DX,DX + 350 0165 92 XCHG AX,DX + 351 0166 BB 2710 MOV BX,10000 + 352 0169 3B D3 CMP DX,BX ;Any 10000's digits? + 353 016B 72 06 JB ASC10K ;If not, skip division + 354 016D 92 XCHG AX,DX + 355 016E F7 F3 DIV BX ;Compute 10000's digit + 356 0170 04 30 ADD AL,"0" + 357 0172 AA STOSB + 358 0173 ASC10K: + 359 ; Convert integer in DX <10^4 to unpacked BCD + 360 0173 33 C0 XOR AX,AX + 361 0175 BB 0A64 MOV BX,10*100H+100 ;10 in BH, 100 in BL + 362 0178 83 FA 64 CMP DX,100 ;Any 100's or 1000's digits? + 363 017B 72 07 JB STO10 ;If not, skip division + 364 017D 92 XCHG AX,DX + 365 017E F6 F3 DIV BL ;Separate 100's and 1000's + 366 0180 86 E2 XCHG AH,DL ;Save remainder and extend with a zero + 367 0182 F6 F7 DIV BH ;Divide by 10 to get 100's and 1000's digits + 368 0184 STO10: + 369 0184 0D 3030 OR AX,"00" + 370 0187 AB STOSW + 371 0188 92 XCHG AX,DX + 372 0189 F6 F7 DIV BH ;Divide by 10 to get 1's and 10's digits + 373 018B 0D 3030 OR AX,"00" + 374 018E AB STOSW + 375 018F C3 RET + 376 + 377 + 378 ;*** $TYPUI - Type unsigned integer + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-8 + + + + 379 ; + 380 ; Inputs: + 381 ; AX = number to print + 382 ; Function: + 383 ; Print a 16-bit unsigned integer to console with zero suppression. + 384 ; Registers: + 385 ; All destroyed + 386 + 387 0190 $TYPUI: + 388 0190 BF 0024 R MOV DI,OFFSET DC:BUF ;Try to use existing routines + 389 0193 E8 0163 R CALL ASCINT ;Convert to ASCII in BUF + 390 0196 E8 00D7 R CALL COUNTDIG ;Skip leading zeroes + 391 + 392 0199 AC typlop: LODSB ;Get character + 393 019A E8 0000 E CALL $$WCHT + 394 019D E2 FA LOOP typlop ;Keep looping until CX=0 + 395 019F C3 RET + 396 + 397 + 398 ;*** ASCRND - Round ASCII digits + 399 ; + 400 ; Inputs: + 401 ; AL = Number of digits wanted + 402 ; CX = Number of digits presently in number + 403 ; DL = Base 10 exponent (D.P. to right of digits) + 404 ; SI = Address of first digit + 405 ; Function: + 406 ; Round number to the specified number of digits. Eliminate trailing + 407 ; zeros from digit count. + 408 ; Outputs: + 409 ; CX = Number of digits now in number (always <= request) + 410 ; DL = Base 10 exponent of rounded number + 411 ; SI = Address of first digit of rounded number + 412 ; DI = Address of formatting buffer, FOBUF + 413 ; Registers: + 414 ; Only BX, BP preserved. + 415 + 416 01A0 ASCRND: + 417 01A0 8B FE MOV DI,SI + 418 01A2 98 CBW ;Zero AH (AL <= 18) + 419 01A3 03 F9 ADD DI,CX ;Point past last digit + 420 01A5 3B C1 CMP AX,CX ;Any extra digits? + 421 01A7 73 22 JAE ZSCAN ;If not, no rounding + 422 01A9 91 XCHG AX,CX ;Say we'll return number requested + 423 01AA 2B C1 SUB AX,CX ;See how many digits we're trimming + 424 01AC 02 D0 ADD DL,AL ;Increase exponent accordingly + 425 01AE 2B F8 SUB DI,AX ;Point to first extra digit + 426 01B0 B0 30 MOV AL,"0" + 427 01B2 86 05 XCHG AL,[DI] ;Get rounding digit and replace it with zero + 428 01B4 3C 35 CMP AL,"5" ;Do we need to round? + 429 01B6 72 13 JB ZSCAN + 430 01B8 E3 0D JCXZ RNDALL + 431 01BA RND: + 432 01BA 4F DEC DI ;Point to digit to round + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-9 + + + + 433 01BB 8A 05 MOV AL,[DI] ;Get a digit that needs incrementing + 434 01BD FE C0 INC AL + 435 01BF 3C 3A CMP AL,"9"+1 ;Did we overflow this digit position? + 436 01C1 72 07 JB STORND ;If not, store it and we're done + 437 01C3 FE C2 INC DL ;Otherwise exponent must be adjusted + 438 01C5 E2 F3 LOOP RND ;We'll need to round next digit + 439 01C7 RNDALL: + 440 01C7 41 INC CX ;Must have at least one digit + 441 01C8 B0 31 MOV AL,"1" ;If we rounded all digits, must be to 1 + 442 01CA STORND: + 443 01CA AA STOSB ;Save rounded digit + 444 01CB ZSCAN: + 445 ;DI points just past the digits we want. Check for trailing zeros. + 446 01CB 4F DEC DI ;Point to last digit + 447 01CC 8A E1 MOV AH,CL ;Remember how many digits we started with + 448 01CE B0 30 MOV AL,"0" + 449 01D0 FD STD ;Scan DOWN + 450 01D1 F3/ AE REPE SCASB ;Scan for "0"s + 451 01D3 FC CLD ;Restore direction UP + 452 01D4 41 INC CX ;Number of digits left + 453 01D5 2A E1 SUB AH,CL ;Number of digits skipped + 454 01D7 02 D4 ADD DL,AH ;Increase base 10 exponent accordingly + 455 01D9 BF 0001 R MOV DI,OFFSET DC:FOBUF + 456 01DC C3 RET + 457 + 458 01DD CODE ENDS + 459 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 01DD BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0177 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0038 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ASC10K . . . . . . . . . . . . . L NEAR 0173 CODE +ASCINT . . . . . . . . . . . . . L NEAR 0163 CODE +ASCRND . . . . . . . . . . . . . L NEAR 01A0 CODE Global +ASCSP. . . . . . . . . . . . . . L NEAR 00C9 CODE +BUF. . . . . . . . . . . . . . . L BYTE 0024 DATA Length =0014 +CONASC . . . . . . . . . . . . . L NEAR 002F CODE Global +COUNTDIG . . . . . . . . . . . . L NEAR 00D7 CODE +DPCON. . . . . . . . . . . . . . L WORD 0000 CONST +DPCONV . . . . . . . . . . . . . L NEAR 012C CODE +DPDIG. . . . . . . . . . . . . . L NEAR 0137 CODE +DRNDTST. . . . . . . . . . . . . L NEAR 0115 CODE +DROUND . . . . . . . . . . . . . L NEAR 0120 CODE +DSHFT. . . . . . . . . . . . . . L NEAR 0109 CODE +EXPTAB . . . . . . . . . . . . . L BYTE 00BE CONST +FIGDIF . . . . . . . . . . . . . L NEAR 003E CODE +FOBUF. . . . . . . . . . . . . . L BYTE 0001 DATA Global Length =0023 +OUTDBL . . . . . . . . . . . . . L NEAR 00E7 CODE +OUTINT . . . . . . . . . . . . . L NEAR 0000 CODE +PMULD. . . . . . . . . . . . . . L NEAR 0000 CODE External +PMULS. . . . . . . . . . . . . . L NEAR 0000 CODE External +PWR10TAB . . . . . . . . . . . . V WORD 0000 CONST External +RND. . . . . . . . . . . . . . . L NEAR 01BA CODE +RNDALL . . . . . . . . . . . . . L NEAR 01C7 CODE +RNDTST . . . . . . . . . . . . . L NEAR 00B5 CODE +ROUND. . . . . . . . . . . . . . L NEAR 00C3 CODE +SAVSGN . . . . . . . . . . . . . L NEAR 0012 CODE +SETSGN . . . . . . . . . . . . . L NEAR 0055 CODE +SHFT . . . . . . . . . . . . . . L NEAR 00AD CODE +SIGN . . . . . . . . . . . . . . L BYTE 0000 DATA Global +STO10. . . . . . . . . . . . . . L NEAR 0184 CODE +STORND . . . . . . . . . . . . . L NEAR 01CA CODE +TYPLOP . . . . . . . . . . . . . L NEAR 0199 CODE +VALTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +ZERO . . . . . . . . . . . . . . L NEAR 001E CODE +ZSCAN. . . . . . . . . . . . . . L NEAR 01CB CODE +$$WCHT . . . . . . . . . . . . . L NEAR 0000 CODE External +$AC. . . . . . . . . . . . . . . V BYTE 0000 DATA External +$DAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$TYPUI . . . . . . . . . . . . . L NEAR 0190 CODE Global + +Warning Severe +Errors Errors +0 0 diff --git a/3_source_code/BASLIB-86/CONASC.ASM b/3_source_code/BASLIB-86/CONASC.ASM new file mode 100644 index 0000000..4550577 --- /dev/null +++ b/3_source_code/BASLIB-86/CONASC.ASM @@ -0,0 +1,418 @@ + TITLE CONASC - Convert number to ASCII + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC SIGN,FOBUF + + EXTRN VALTYP:BYTE, $FAC:BYTE, $AC:BYTE, $DAC:BYTE + +SIGN DB ? +FOBUF DB 35 DUP (?) ;Numeric output buffer +BUF DB 20 DUP (?) ;ASCII conversion buffer + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN PWR10TAB:WORD + +; Table of integers 10^X, for X=18 down to 8, for converting DP numbers + +DPCON LABEL WORD + DW 0000H,0A764H,0B6B3H,0DE0H ;10^18 + DW 0000H,5D8AH,4578H,163H ;10^17 + DW 0000H,6FC1H,86F2H,23H ;10^16 + DW 8000H,0A4C6H,8D7EH,3 ;10^15 + DW 4000H,107AH,5AF3H,0 ;10^14 + DW 0A000H,4E72H,918H,0 ;10^13 + DW 1000H,0D4A5H,0E8H,0 ;10^12 + DW 0E800H,4876H,17H,0 ;10^11 + DW 0E400H,540BH,2,0 ;10^10 + DW 0CA00H,3B9AH,0,0 ;10^9 + DW 0E100H,5F5H,0,0 ;10^8 + + +;EXPTAB - Lookup table for exponents +;An actual base 2 exponent of 25 or 57 (for SP or DP, respectively) is needed +;before a number may be converted from binary to decimal. This is because such +;an exponent ensures the mantissa is just a big integer. The difference +;between the desired exponent (25 or 57) and the present one is figured and +;used as an index into this table. The entries in the table represent the +;power of 10 to multiply by to get the needed exponent. The table covers +;an exponent difference range of -102 [25-127] to +184 [57-(-127)]. + + DB -30,-30,-30,-29,-29,-29 ;-102 to -97 + DB -28,-28,-28,-27,-27,-27,-27,-26 ;-96 to -89 + DB -26,-26,-25,-25,-25,-24,-24,-24 ;-88 to -81 + DB -24,-23,-23,-23,-22,-22,-22,-21 ;-80 to -73 + DB -21,-21,-21,-20,-20,-20,-19,-19 ;-72 to -65 + DB -19,-18,-18,-18,-18,-17,-17,-17 ;-64 to -57 + DB -16,-16,-16,-15,-15,-15,-15,-14 ;-56 to -49 + DB -14,-14,-13,-13,-13,-12,-12,-12 ;-48 to -41 + DB -12,-11,-11,-11,-10,-10,-10,-9 ;-40 to -33 + DB -9,-9,-9,-8,-8,-8,-7,-7 ;-32 to -25 + DB -7,-6,-6,-6,-6,-5,-5,-5 ;-24 to -17 + DB -4,-4,-4,-3,-3,-3,-3,-2 ;-16 to -9 + DB -2,-2,-1,-1,-1,0,0,0 ;-8 to -1 +EXPTAB LABEL BYTE ;Table is centered on zero + DB 0,1,1,1,2,2,2,3 ;0 to 7 + DB 3,3,4,4,4,4,5,5 ;8 to 15 + DB 5,6,6,6,7,7,7,7 ;16 to 23 + DB 8,8,8,9,9,9,10,10 ;24 to 31 + DB 10,10,11,11,11,12,12,12 ;32 to 39 + DB 13,13,13,13,14,14,14,15 ;40 to 47 + DB 15,15,16,16,16,16,17,17 ;48 to 55 + DB 17,18,18,18,19,19,19,19 ;56 to 63 + DB 20,20,20,21,21,21,22,22 ;64 to 71 + DB 22,22,23,23,23,24,24,24 ;72 to 79 + DB 25,25,25,25,26,26,26,27 ;80 to 87 + DB 27,27,28,28,28,28,29,29 ;88 to 95 + DB 29,30,30,30,31,31,31,32 ;96 to 103 + DB 32,32,32,33,33,33,34,34 ;104 to 111 + DB 34,35,35,35,35,36,36,36 ;112 to 119 + DB 37,37,37,38,38,38,38,39 ;120 to 127 + DB 39,39,40,40,40,41,41,41 ;128 to 135 + DB 41,42,42,42,43,43,43,44 ;136 to 143 + DB 44,44,44,45,45,45,46,46 ;144 to 151 + DB 46,47,47,47,47,48,48,48 ;152 to 159 + DB 49,49,49,50,50,50,50,51 ;160 to 167 + DB 51,51,52,52,52,53,53,53 ;168 to 175 + DB 53,54,54,54,55,55,55,56 ;176 to 183 + DB 56 ;184 + +CONST ENDS + +DC GROUP CONST,DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC CONASC, ASCRND, $TYPUI + + EXTRN PMULS:NEAR, PMULD:NEAR + EXTRN $$WCHT:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +OUTINT: ;This is a continuation of CONASC, below + MOV DI,OFFSET DC:BUF ;Save digits in BUF + MOV AX,WORD PTR[$AC] ;Get integer to convert + MOV DL," " ;In case sign is positive + OR AX,AX + JZ ZERO + JNS SAVSGN ;Positive? + NEG AX ;Force in positive + MOV DL,"-" +SAVSGN: + MOV [SIGN],DL ;Record the sign + CALL ASCINT ;Convert it to ASCII + MOV DL,0 ;Base 10 exponent is zero + JMP COUNTDIG + +ZERO: + MOV [SIGN]," " ;Show positive sign + MOV CX,1 ;Only one digit + MOV DL,0 ;Zero base 10 exponent + MOV SI,OFFSET DC:BUF + MOV BYTE PTR [SI],"0" + RET + + +;*** CONASC - Convert number to ASCII +; +; Inputs: +; $AC has integer or SP number OR $DAC has DP number +; VALTYP has type (2=integer, 4=SP, 8=DP) +; Function: +; Convert number to a string of ASCII digits with no leading or +; trailing zeros. Return base 10 exponent and count of digits. +; Outputs: +; CX = number of significant figures (decimal point to right) +; DL = base 10 exponent +; SI = Address of first digit (non-zero unless number is zero) +; [SIGN] has sign - blank if positive, "-" if negative +; Registers: +; Uses all. + +CONASC: + CMP [VALTYP],4 ;Check type of number + JB OUTINT + MOV BX,25+128 ;Desired exponent for SP (plus bias) + JZ FIGDIF ;SP number? + ADD BX,32 ;32 bits more for DP +FIGDIF: + MOV DL,[$FAC] ;Get exponent + OR DL,DL ;Is number zero? + JZ ZERO ;That was easy + MOV DH,0 + SUB BX,DX ;See what we have to do to get desired exp. + MOV AL," " ;In case its positive + TEST [$FAC-1],80H ;Check sign bit + JZ SETSGN ;Positive? + MOV AL,"-" +SETSGN: + MOV [SIGN],AL + MOV AL,OFFSET DC:EXPTAB[BX] ;What power of 10 will give us the right exp? + CBW + MOV SI,AX + SHL SI,1 ;8 bytes per entry in power of 10 table + SHL SI,1 + SHL SI,1 + ADD SI,OFFSET DC:PWR10TAB + MOV AH,[SI+7] ;Get base 2 exponent of this power of 10 + ADD AH,DL ;Compute exponent resulting from multiply + NEG AL ;Take account of multiplying by power of 10 + PUSH AX ;Save base 2 and base 10 exponents + CMP [VALTYP],4 ;SP number? + JNZ OUTDBL ;If not, go do double precision calculations + MOV DI,WORD PTR[$AC] ;Load up number to convert + MOV CL,[$AC+2] + MOV BL,[SI+6] ;Load up power of 10 + MOV AL,BYTE PTR[SI+3] ;Get byte below least significant + OR CL,80H ;Set implied bit + MUL CL ;Compute least significant partial product + MOV SI,[SI+4] + PUSH AX + CALL PMULS ;Multiply mantissas - result in AX:BX + POP DX ;Retrieve least significant partial product + ADD BL,DH ;Accumulate it + ADC BH,0 + ADC AX,0 + MOV DH,0 ;Shuffle to get result in DX:AL:BL + MOV DL,AH + MOV AH,AL + MOV AL,BH + POP CX ;Recover base 2 exponent + PUSH CX + XCHG CL,CH ;Base 2 exponent in CL + AND CX,7 ;We'll be within 4 of desired exponent + JZ RNDTST ;Hit it exactly? +;Exponent did not turn out to be exactly 24 - it could be as much as 29. +;For every power of two larger, we must shift another bit into the mantissa, +;so that when we're done we have the same number of bits as the exponent says. +SHFT: + SHL BL,1 + RCL AX,1 + RCL DX,1 + LOOP SHFT +RNDTST: + MOV DI,OFFSET DC:BUF ;Save characters in BUF + CMP BL,80H ;Do we need to round? + JA ROUND ;Yes + JB ASCSP ;No + TEST AL,1 ;Maybe - round even + JZ ASCSP +ROUND: + ADD AX,1 ;Round up + ADC DX,0 ;Propagate carry +ASCSP: + MOV BX,10000 ;Break number in to 2 manageable chunks + DIV BX + PUSH DX ;Save low half for later + CALL ASCINT ;Convert high 5 digits + POP DX + CALL ASC10K ;Convert last 4 digits + POP DX ;DL = base 10 exponent +COUNTDIG: + MOV CX,DI + MOV DI,OFFSET DC:BUF + SUB CX,DI ;Number of digits converted + MOV AL,"0" + REPE SCASB ;Scan off leading zeros + INC CX ;Number of digits left + DEC DI ;Point to first digit + MOV SI,DI + RET + +OUTDBL: + MOV DI,OFFSET DC:$DAC + CALL PMULD ;Result in DI:BX:CX:DX + MOV AL,CH ;Get result in BX:BP:DI:AX:DL + MOV AH,BL + XCHG AX,DI + MOV BL,AH + MOV AH,AL + MOV AL,BH + XCHG AX,BP + MOV BH,0 + MOV AL,DH + MOV AH,CL + POP CX ;Recover base 2 exponent + PUSH CX + XCHG CL,CH ;Base 2 exponent in CL + AND CX,7 ;We'll be within 4 of desired exponent + JZ DRNDTST ;Hit it exactly? +;Exponent did not turn out to be exactly 56 - it could be as much as 61. +;For every power of two larger, we must shift another bit into the mantissa, +;so that when we're done we have the same number of bits as the exponent says. +DSHFT: + SHL DL,1 + RCL AX,1 + RCL DI,1 + RCL BP,1 + RCL BX,1 + LOOP DSHFT +DRNDTST: + CMP DL,80H ;Need to round? + JA DROUND ;Yes + JB DPCONV ;No + TEST AL,1 ;Maybe - round even + JZ DPCONV +DROUND: + ADD AX,1 + ADC DI,0 + ADC BP,0 + ADC BX,0 +DPCONV: + MOV DX,DI ;Number now in BX:BP:DX:AX + MOV DI,OFFSET DC:BUF ;Save characters in BUF + MOV CX,11 ;19 digits - last 8 handled by SP converter + MOV SI,OFFSET DC:DPCON ;Table of powers of 10 +DPDIG: + SUB AX,[SI] ;Subtract a power of 10 + SBB DX,[SI+2] + SBB BP,[SI+4] + SBB BX,[SI+6] + INC CH ;Count in case successful + JNC DPDIG ;Divide by 10^X by repeat subtraction +;We subtracted one too many, so restore + ADD AX,[SI] + ADC DX,[SI+2] + ADC BP,[SI+4] + ADC BX,[SI+6] + DEC CH + ADD SI,8 ;Bump up to next power of 10 + OR CH,"0" + MOV [DI],CH ;Store the digit + INC DI + MOV CH,0 ;Initialize count for next power of 10 + LOOP DPDIG +;What we have left now is a number in DX:AX < 10^8 + JMP ASCSP + + +;*** ASCINT = Convert 2-byte integer to ASCII +; +; Inputs: +; AX = integer +; DI = pointer to digit buffer +; Function: +; Convert the integer to 5 unpacked BCD digits, stored at [DI]. +; Outputs: +; None. +; Registers: +; All destroyed. + +ASCINT: + XOR DX,DX + XCHG AX,DX + MOV BX,10000 + CMP DX,BX ;Any 10000's digits? + JB ASC10K ;If not, skip division + XCHG AX,DX + DIV BX ;Compute 10000's digit + ADD AL,"0" + STOSB +ASC10K: +; Convert integer in DX <10^4 to unpacked BCD + XOR AX,AX + MOV BX,10*100H+100 ;10 in BH, 100 in BL + CMP DX,100 ;Any 100's or 1000's digits? + JB STO10 ;If not, skip division + XCHG AX,DX + DIV BL ;Separate 100's and 1000's + XCHG AH,DL ;Save remainder and extend with a zero + DIV BH ;Divide by 10 to get 100's and 1000's digits +STO10: + OR AX,"00" + STOSW + XCHG AX,DX + DIV BH ;Divide by 10 to get 1's and 10's digits + OR AX,"00" + STOSW + RET + + +;*** $TYPUI - Type unsigned integer +; +; Inputs: +; AX = number to print +; Function: +; Print a 16-bit unsigned integer to console with zero suppression. +; Registers: +; All destroyed + +$TYPUI: + MOV DI,OFFSET DC:BUF ;Try to use existing routines + CALL ASCINT ;Convert to ASCII in BUF + CALL COUNTDIG ;Skip leading zeroes + +typlop: LODSB ;Get character + CALL $$WCHT + LOOP typlop ;Keep looping until CX=0 + RET + + +;*** ASCRND - Round ASCII digits +; +; Inputs: +; AL = Number of digits wanted +; CX = Number of digits presently in number +; DL = Base 10 exponent (D.P. to right of digits) +; SI = Address of first digit +; Function: +; Round number to the specified number of digits. Eliminate trailing +; zeros from digit count. +; Outputs: +; CX = Number of digits now in number (always <= request) +; DL = Base 10 exponent of rounded number +; SI = Address of first digit of rounded number +; DI = Address of formatting buffer, FOBUF +; Registers: +; Only BX, BP preserved. + +ASCRND: + MOV DI,SI + CBW ;Zero AH (AL <= 18) + ADD DI,CX ;Point past last digit + CMP AX,CX ;Any extra digits? + JAE ZSCAN ;If not, no rounding + XCHG AX,CX ;Say we'll return number requested + SUB AX,CX ;See how many digits we're trimming + ADD DL,AL ;Increase exponent accordingly + SUB DI,AX ;Point to first extra digit + MOV AL,"0" + XCHG AL,[DI] ;Get rounding digit and replace it with zero + CMP AL,"5" ;Do we need to round? + JB ZSCAN + JCXZ RNDALL +RND: + DEC DI ;Point to digit to round + MOV AL,[DI] ;Get a digit that needs incrementing + INC AL + CMP AL,"9"+1 ;Did we overflow this digit position? + JB STORND ;If not, store it and we're done + INC DL ;Otherwise exponent must be adjusted + LOOP RND ;We'll need to round next digit +RNDALL: + INC CX ;Must have at least one digit + MOV AL,"1" ;If we rounded all digits, must be to 1 +STORND: + STOSB ;Save rounded digit +ZSCAN: +;DI points just past the digits we want. Check for trailing zeros. + DEC DI ;Point to last digit + MOV AH,CL ;Remember how many digits we started with + MOV AL,"0" + STD ;Scan DOWN + REPE SCASB ;Scan for "0"s + CLD ;Restore direction UP + INC CX ;Number of digits left + SUB AH,CL ;Number of digits skipped + ADD DL,AH ;Increase base 10 exponent accordingly + MOV DI,OFFSET DC:FOBUF + RET + +CODE ENDS + END From cdc7df79c26e170a5fd2fb5b06d392ddf99fd35a Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 13 Jun 2026 15:14:58 -0700 Subject: [PATCH 05/53] Transcription of Bundle 9 - CONST.ASM Code and Listing Corrected data entry error in CONASC.ASM --- 2_printed_files/bundle_09/CONASC.ASM | 1 + 2_printed_files/bundle_09/CONST.ASM | 180 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/CONST.ASM | 76 +++++++++++ 3 files changed, 257 insertions(+) create mode 100644 2_printed_files/bundle_09/CONST.ASM create mode 100644 3_source_code/BASLIB-86/CONST.ASM diff --git a/2_printed_files/bundle_09/CONASC.ASM b/2_printed_files/bundle_09/CONASC.ASM index 4ce8546..b27dea6 100644 --- a/2_printed_files/bundle_09/CONASC.ASM +++ b/2_printed_files/bundle_09/CONASC.ASM @@ -1,6 +1,7 @@ CONASC - Convert number to ASCII Macro-86 %1(12) 0:58:40 13-Nov-81 Page 1-1 + 1 TITLE CONASC - Convert number to ASCII 2 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' diff --git a/2_printed_files/bundle_09/CONST.ASM b/2_printed_files/bundle_09/CONST.ASM new file mode 100644 index 0000000..486bb00 --- /dev/null +++ b/2_printed_files/bundle_09/CONST.ASM @@ -0,0 +1,180 @@ +CONST - Floating point constants Macro-86 %1(12) 0:58:58 13-Nov-81 Page 1-1 + + + +1 TITLE CONST - Floating point constants +2 +3 0000 CONST SEGMENT WORD PUBLIC 'CONST' +4 +5 PUBLIC $HALFSQR2,$HALFPI,$RECIP2PI,$SIXTHPI,$SQRT3,$TANTWELFTHPI +6 PUBLIC $LOG2E,$LN2,$ONEHALF,$ONE4TH +7 PUBLIC $DLOG2E,$DHALFLN2,$DHALFSQR2,$DBLHALF,$DBL4TH +8 PUBLIC $DHALFPI,$DRECIP2PI,$DSIXTHPI,$DSQRT3,$DTANTWELFTHPI +9 +10 ;When a single precision constant does not need to be rounded up, the +11 ;corresponding double precision constant will use it as its high 4 bytes. +12 ; These constants have been checked with MuMath +13 +14 0000 65 DE F9 33 $DHALFSQR2 DB 065H,0DEH,0F9H,033H +15 0004 F3 04 35 80 $HALFSQR2 DB 0F3H,004H,035H,080H ;SQRT(2)/2 +16 +17 0008 15 44 4E 6E $DRECIP2PI DB 015H,044H,04EH,06EH +18 000C 83 F9 22 7E $RECIP2PI DB 083H,0F9H,022H,07EH ;1/(2*PI) +19 +20 0010 C2 68 21 A2 DA 0F $DHALFPI DB 0C2H,068H,021H,0A2H,0DAH,00FH,049H,081H +21 49 81 +22 0018 DB 0F 49 81 $HALFPI DB 0DBH,00FH,049H,081H ;PI/2 +23 +24 001C 2C 9B 6B C1 91 0A $DSIXTHPI DB 02CH,09BH,06BH,0C1H,091H,00AH,006H,080H +25 06 80 +26 0024 92 0A 06 80 $SIXTHPI DB 092H,00AH,006H,080H ;PI/6 +27 +28 0028 B2 6A F6 F4 A2 30 $DTANTWELFTHPI DB 0B2H,06AH,0F6H,0F4H,0A2H,030H,009H,07FH +29 09 7F +30 0030 A3 30 09 7F $TANTWELFTHPI DB 0A3H,030H,009H,07FH ;Tan(PI/12) +31 +32 0034 54 65 C2 42 $DSQRT3 DB 054H,065H,0C2H,042H +33 0038 D7 B3 5D 81 $SQRT3 DB 0D7H,0B3H,05DH,081H ;1/Tan(30 degrees) = SQRT(3) +34 +35 003C F1 17 5C 29 $DLOG2E DB 0F1H,017H,05CH,029H +36 0040 3B AA 38 81 $LOG2E DB 03BH,0AAH,038H,081H ;LOG base 2 of e +37 +38 0044 7A CF D1 F7 17 72 $DHALFLN2 DB 07AH,0CFH,0D1H,0F7H,017H,072H,031H,07FH +39 31 7F +40 004C 18 72 31 80 $LN2 DB 018H,072H,031H,080H ;LN(2) +41 +42 0050 00 00 00 00 $DBLHALF DB 0,0,0,0 +43 0054 00 00 00 80 $ONEHALF DB 0,0,0,80H +44 +45 0058 00 00 00 00 $DBL4TH DB 0,0,0,0 +46 005C 00 00 00 7F $ONE4TH DB 0,0,0,7FH +47 +48 0060 CONST ENDS +49 +50 0000 DATA SEGMENT WORD PUBLIC 'DATA' +51 +52 PUBLIC $ARG,$TEMP,$TEMP2 +53 +54 EXTRN $AC:WORD, $DAC:WORD + + +CONST - Floating point constants Macro-86 %1(12) 0:58:58 13-Nov-81 Page 1-2 + + + +55 +56 0000 04 [ $ARG DW 4 DUP(?) +57 ???? +58 ] +59 +60 0008 04 [ $TEMP DW 4 DUP(?) +61 ???? +62 ] +63 +64 0010 04 [ $TEMP2 DW 4 DUP(?) +65 ???? +66 ] +67 +68 +69 0018 DATA ENDS +70 +71 DC GROUP DATA,CONST +72 +73 0000 CODE SEGMENT BYTE PUBLIC 'CODE' +74 +75 PUBLIC $PUT1, $PUT1D +76 +77 ASSUME CS:CODE, DS:DC, ES:DC +78 +79 0000 $PUT1D: +80 0000 33 C0 XOR AX,AX +81 0002 A3 0000 E MOV [$DAC],AX +82 0005 A3 0002 E MOV [$DAC+2],AX +83 0008 $PUT1: +84 0008 C7 06 0000 E 0000 MOV [$AC],0 +85 000E C7 06 0002 E 8100 MOV [$AC+2],8100H +86 0014 C3 RET +87 +88 0015 CODE ENDS +89 END + + + + + + + + + + + + + + + + + + + + + +CONST - Floating point constants Macro-86 %1(12) 0:58:58 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0015 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0018 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 0060 WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ARG . . . . . . . . . . . . . . L WORD 0000 DATA Global Length =0004 +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DBL4TH. . . . . . . . . . . . . L BYTE 0058 CONST Global +$DBLHALF . . . . . . . . . . . . L BYTE 0050 CONST Global +$DHALFLN2. . . . . . . . . . . . L BYTE 0044 CONST Global +$DHALFPI . . . . . . . . . . . . L BYTE 0010 CONST Global +$DHALFSQR2 . . . . . . . . . . . L BYTE 0000 CONST Global +$DLOG2E. . . . . . . . . . . . . L BYTE 003C CONST Global +$DRECIP2PI . . . . . . . . . . . L BYTE 0008 CONST Global +$DSIXTHPI. . . . . . . . . . . . L BYTE 001C CONST Global +$DSQRT3. . . . . . . . . . . . . L BYTE 0034 CONST Global +$DTANTWELFTHPI . . . . . . . . . L BYTE 0028 CONST Global +$HALFPI. . . . . . . . . . . . . L BYTE 0018 CONST Global +$HALFSQR2. . . . . . . . . . . . L BYTE 0004 CONST Global +$LN2 . . . . . . . . . . . . . . L BYTE 004C CONST Global +$LOG2E . . . . . . . . . . . . . L BYTE 0040 CONST Global +$ONE4TH. . . . . . . . . . . . . L BYTE 005C CONST Global +$ONEHALF . . . . . . . . . . . . L BYTE 0054 CONST Global +$PUT1. . . . . . . . . . . . . . L NEAR 0008 CODE Global +$PUT1D . . . . . . . . . . . . . L NEAR 0000 CODE Global +$RECIP2PI. . . . . . . . . . . . L BYTE 000C CONST Global +$SIXTHPI . . . . . . . . . . . . L BYTE 0024 CONST Global +$SQRT3 . . . . . . . . . . . . . L BYTE 0038 CONST Global +$TANTWELFTHPI. . . . . . . . . . L BYTE 0030 CONST Global +$TEMP. . . . . . . . . . . . . . L WORD 0008 DATA Global Length =0004 +$TEMP2 . . . . . . . . . . . . . L WORD 0010 DATA Global Length =0004 + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/CONST.ASM b/3_source_code/BASLIB-86/CONST.ASM new file mode 100644 index 0000000..b1ebd38 --- /dev/null +++ b/3_source_code/BASLIB-86/CONST.ASM @@ -0,0 +1,76 @@ + TITLE CONST - Floating point constants + +CONST SEGMENT WORD PUBLIC 'CONST' + + PUBLIC $HALFSQR2,$HALFPI,$RECIP2PI,$SIXTHPI,$SQRT3,$TANTWELFTHPI + PUBLIC $LOG2E,$LN2,$ONEHALF,$ONE4TH + PUBLIC $DLOG2E,$DHALFLN2,$DHALFSQR2,$DBLHALF,$DBL4TH + PUBLIC $DHALFPI,$DRECIP2PI,$DSIXTHPI,$DSQRT3,$DTANTWELFTHPI + +;When a single precision constant does not need to be rounded up, the +;corresponding double precision constant will use it as its high 4 bytes. +; These constants have been checked with MuMath + +$DHALFSQR2 DB 065H,0DEH,0F9H,033H +$HALFSQR2 DB 0F3H,004H,035H,080H ;SQRT(2)/2 + +$DRECIP2PI DB 015H,044H,04EH,06EH +$RECIP2PI DB 083H,0F9H,022H,07EH ;1/(2*PI) + +$DHALFPI DB 0C2H,068H,021H,0A2H,0DAH,00FH,049H,081H +$HALFPI DB 0DBH,00FH,049H,081H ;PI/2 + +$DSIXTHPI DB 02CH,09BH,06BH,0C1H,091H,00AH,006H,080H +$SIXTHPI DB 092H,00AH,006H,080H ;PI/6 + +$DTANTWELFTHPI DB 0B2H,06AH,0F6H,0F4H,0A2H,030H,009H,07FH +$TANTWELFTHPI DB 0A3H,030H,009H,07FH ;Tan(PI/12) + +$DSQRT3 DB 054H,065H,0C2H,042H +$SQRT3 DB 0D7H,0B3H,05DH,081H ;1/Tan(30 degrees) = SQRT(3) + +$DLOG2E DB 0F1H,017H,05CH,029H +$LOG2E DB 03BH,0AAH,038H,081H ;LOG base 2 of e + +$DHALFLN2 DB 07AH,0CFH,0D1H,0F7H,017H,072H,031H,07FH +$LN2 DB 018H,072H,031H,080H ;LN(2) + +$DBLHALF DB 0,0,0,0 +$ONEHALF DB 0,0,0,80H + +$DBL4TH DB 0,0,0,0 +$ONE4TH DB 0,0,0,7FH + +CONST ENDS + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC $ARG,$TEMP,$TEMP2 + + EXTRN $AC:WORD, $DAC:WORD + +$ARG DW 4 DUP(?) +$TEMP DW 4 DUP(?) +$TEMP2 DW 4 DUP(?) + +DATA ENDS + +DC GROUP DATA,CONST + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $PUT1, $PUT1D + + ASSUME CS:CODE, DS:DC, ES:DC + +$PUT1D: + XOR AX,AX + MOV [$DAC],AX + MOV [$DAC+2],AX +$PUT1: + MOV [$AC],0 + MOV [$AC+2],8100H + RET + +CODE ENDS + END From e482388e12214c784acc0e6d9c10e072c854f563 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sun, 14 Jun 2026 13:09:59 -0700 Subject: [PATCH 06/53] Transcription of Bundle 9 - CONV.ASM Code and Listing Corrected data entry error in CONST.ASM Notes: Line 77 in CONV.ASM throws "Error-31:Operand types must match" in MASM trying to OR a WORD value with a BYTE register. It still generates the same code as the listing however. --- 2_printed_files/bundle_09/CONST.ASM | 178 ++++++++--------- 2_printed_files/bundle_09/CONV.ASM | 300 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/CONV.ASM | 216 ++++++++++++++++++++ 3 files changed, 605 insertions(+), 89 deletions(-) create mode 100644 2_printed_files/bundle_09/CONV.ASM create mode 100644 3_source_code/BASLIB-86/CONV.ASM diff --git a/2_printed_files/bundle_09/CONST.ASM b/2_printed_files/bundle_09/CONST.ASM index 486bb00..f12d276 100644 --- a/2_printed_files/bundle_09/CONST.ASM +++ b/2_printed_files/bundle_09/CONST.ASM @@ -2,101 +2,101 @@ CONST - Floating point constants Macro-86 %1(12) -1 TITLE CONST - Floating point constants -2 -3 0000 CONST SEGMENT WORD PUBLIC 'CONST' -4 -5 PUBLIC $HALFSQR2,$HALFPI,$RECIP2PI,$SIXTHPI,$SQRT3,$TANTWELFTHPI -6 PUBLIC $LOG2E,$LN2,$ONEHALF,$ONE4TH -7 PUBLIC $DLOG2E,$DHALFLN2,$DHALFSQR2,$DBLHALF,$DBL4TH -8 PUBLIC $DHALFPI,$DRECIP2PI,$DSIXTHPI,$DSQRT3,$DTANTWELFTHPI -9 -10 ;When a single precision constant does not need to be rounded up, the -11 ;corresponding double precision constant will use it as its high 4 bytes. -12 ; These constants have been checked with MuMath -13 -14 0000 65 DE F9 33 $DHALFSQR2 DB 065H,0DEH,0F9H,033H -15 0004 F3 04 35 80 $HALFSQR2 DB 0F3H,004H,035H,080H ;SQRT(2)/2 -16 -17 0008 15 44 4E 6E $DRECIP2PI DB 015H,044H,04EH,06EH -18 000C 83 F9 22 7E $RECIP2PI DB 083H,0F9H,022H,07EH ;1/(2*PI) -19 -20 0010 C2 68 21 A2 DA 0F $DHALFPI DB 0C2H,068H,021H,0A2H,0DAH,00FH,049H,081H -21 49 81 -22 0018 DB 0F 49 81 $HALFPI DB 0DBH,00FH,049H,081H ;PI/2 -23 -24 001C 2C 9B 6B C1 91 0A $DSIXTHPI DB 02CH,09BH,06BH,0C1H,091H,00AH,006H,080H -25 06 80 -26 0024 92 0A 06 80 $SIXTHPI DB 092H,00AH,006H,080H ;PI/6 -27 -28 0028 B2 6A F6 F4 A2 30 $DTANTWELFTHPI DB 0B2H,06AH,0F6H,0F4H,0A2H,030H,009H,07FH -29 09 7F -30 0030 A3 30 09 7F $TANTWELFTHPI DB 0A3H,030H,009H,07FH ;Tan(PI/12) -31 -32 0034 54 65 C2 42 $DSQRT3 DB 054H,065H,0C2H,042H -33 0038 D7 B3 5D 81 $SQRT3 DB 0D7H,0B3H,05DH,081H ;1/Tan(30 degrees) = SQRT(3) -34 -35 003C F1 17 5C 29 $DLOG2E DB 0F1H,017H,05CH,029H -36 0040 3B AA 38 81 $LOG2E DB 03BH,0AAH,038H,081H ;LOG base 2 of e -37 -38 0044 7A CF D1 F7 17 72 $DHALFLN2 DB 07AH,0CFH,0D1H,0F7H,017H,072H,031H,07FH -39 31 7F -40 004C 18 72 31 80 $LN2 DB 018H,072H,031H,080H ;LN(2) -41 -42 0050 00 00 00 00 $DBLHALF DB 0,0,0,0 -43 0054 00 00 00 80 $ONEHALF DB 0,0,0,80H -44 -45 0058 00 00 00 00 $DBL4TH DB 0,0,0,0 -46 005C 00 00 00 7F $ONE4TH DB 0,0,0,7FH -47 -48 0060 CONST ENDS -49 -50 0000 DATA SEGMENT WORD PUBLIC 'DATA' -51 -52 PUBLIC $ARG,$TEMP,$TEMP2 -53 -54 EXTRN $AC:WORD, $DAC:WORD + 1 TITLE CONST - Floating point constants + 2 + 3 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 4 + 5 PUBLIC $HALFSQR2,$HALFPI,$RECIP2PI,$SIXTHPI,$SQRT3,$TANTWELFTHPI + 6 PUBLIC $LOG2E,$LN2,$ONEHALF,$ONE4TH + 7 PUBLIC $DLOG2E,$DHALFLN2,$DHALFSQR2,$DBLHALF,$DBL4TH + 8 PUBLIC $DHALFPI,$DRECIP2PI,$DSIXTHPI,$DSQRT3,$DTANTWELFTHPI + 9 + 10 ;When a single precision constant does not need to be rounded up, the + 11 ;corresponding double precision constant will use it as its high 4 bytes. + 12 ; These constants have been checked with MuMath + 13 + 14 0000 65 DE F9 33 $DHALFSQR2 DB 065H,0DEH,0F9H,033H + 15 0004 F3 04 35 80 $HALFSQR2 DB 0F3H,004H,035H,080H ;SQRT(2)/2 + 16 + 17 0008 15 44 4E 6E $DRECIP2PI DB 015H,044H,04EH,06EH + 18 000C 83 F9 22 7E $RECIP2PI DB 083H,0F9H,022H,07EH ;1/(2*PI) + 19 + 20 0010 C2 68 21 A2 DA 0F $DHALFPI DB 0C2H,068H,021H,0A2H,0DAH,00FH,049H,081H + 21 49 81 + 22 0018 DB 0F 49 81 $HALFPI DB 0DBH,00FH,049H,081H ;PI/2 + 23 + 24 001C 2C 9B 6B C1 91 0A $DSIXTHPI DB 02CH,09BH,06BH,0C1H,091H,00AH,006H,080H + 25 06 80 + 26 0024 92 0A 06 80 $SIXTHPI DB 092H,00AH,006H,080H ;PI/6 + 27 + 28 0028 B2 6A F6 F4 A2 30 $DTANTWELFTHPI DB 0B2H,06AH,0F6H,0F4H,0A2H,030H,009H,07FH + 29 09 7F + 30 0030 A3 30 09 7F $TANTWELFTHPI DB 0A3H,030H,009H,07FH ;Tan(PI/12) + 31 + 32 0034 54 65 C2 42 $DSQRT3 DB 054H,065H,0C2H,042H + 33 0038 D7 B3 5D 81 $SQRT3 DB 0D7H,0B3H,05DH,081H ;1/Tan(30 degrees) = SQRT(3) + 34 + 35 003C F1 17 5C 29 $DLOG2E DB 0F1H,017H,05CH,029H + 36 0040 3B AA 38 81 $LOG2E DB 03BH,0AAH,038H,081H ;LOG base 2 of e + 37 + 38 0044 7A CF D1 F7 17 72 $DHALFLN2 DB 07AH,0CFH,0D1H,0F7H,017H,072H,031H,07FH + 39 31 7F + 40 004C 18 72 31 80 $LN2 DB 018H,072H,031H,080H ;LN(2) + 41 + 42 0050 00 00 00 00 $DBLHALF DB 0,0,0,0 + 43 0054 00 00 00 80 $ONEHALF DB 0,0,0,80H + 44 + 45 0058 00 00 00 00 $DBL4TH DB 0,0,0,0 + 46 005C 00 00 00 7F $ONE4TH DB 0,0,0,7FH + 47 + 48 0060 CONST ENDS + 49 + 50 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 51 + 52 PUBLIC $ARG,$TEMP,$TEMP2 + 53 + 54 EXTRN $AC:WORD, $DAC:WORD CONST - Floating point constants Macro-86 %1(12) 0:58:58 13-Nov-81 Page 1-2 -55 -56 0000 04 [ $ARG DW 4 DUP(?) -57 ???? -58 ] -59 -60 0008 04 [ $TEMP DW 4 DUP(?) -61 ???? -62 ] -63 -64 0010 04 [ $TEMP2 DW 4 DUP(?) -65 ???? -66 ] -67 -68 -69 0018 DATA ENDS -70 -71 DC GROUP DATA,CONST -72 -73 0000 CODE SEGMENT BYTE PUBLIC 'CODE' -74 -75 PUBLIC $PUT1, $PUT1D -76 -77 ASSUME CS:CODE, DS:DC, ES:DC -78 -79 0000 $PUT1D: -80 0000 33 C0 XOR AX,AX -81 0002 A3 0000 E MOV [$DAC],AX -82 0005 A3 0002 E MOV [$DAC+2],AX -83 0008 $PUT1: -84 0008 C7 06 0000 E 0000 MOV [$AC],0 -85 000E C7 06 0002 E 8100 MOV [$AC+2],8100H -86 0014 C3 RET -87 -88 0015 CODE ENDS -89 END + 55 + 56 0000 04 [ $ARG DW 4 DUP(?) + 57 ???? + 58 ] + 59 + 60 0008 04 [ $TEMP DW 4 DUP(?) + 61 ???? + 62 ] + 63 + 64 0010 04 [ $TEMP2 DW 4 DUP(?) + 65 ???? + 66 ] + 67 + 68 + 69 0018 DATA ENDS + 70 + 71 DC GROUP DATA,CONST + 72 + 73 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 74 + 75 PUBLIC $PUT1, $PUT1D + 76 + 77 ASSUME CS:CODE, DS:DC, ES:DC + 78 + 79 0000 $PUT1D: + 80 0000 33 C0 XOR AX,AX + 81 0002 A3 0000 E MOV [$DAC],AX + 82 0005 A3 0002 E MOV [$DAC+2],AX + 83 0008 $PUT1: + 84 0008 C7 06 0000 E 0000 MOV [$AC],0 + 85 000E C7 06 0002 E 8100 MOV [$AC+2],8100H + 86 0014 C3 RET + 87 + 88 0015 CODE ENDS + 89 END diff --git a/2_printed_files/bundle_09/CONV.ASM b/2_printed_files/bundle_09/CONV.ASM new file mode 100644 index 0000000..80ecc59 --- /dev/null +++ b/2_printed_files/bundle_09/CONV.ASM @@ -0,0 +1,300 @@ +CONV - Conversions between single, double, and integer Macro-86 %1(12) 0:59:2 13-Nov-81 Page 1-1 + + + + 1 TITLE CONV - Conversions between single, double, and integer + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:WORD, $AC:WORD, $DAC:WORD, $$SPSV:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 DC GROUP DATA + 10 + 11 0000 CODE SEGMENT WORD PUBLIC 'CODE' + 12 + 13 PUBLIC $CDPA,$CDPB,$CISA,$CIDA,$CSPA,$CSPB + 14 PUBLIC $CINA,$CINB,$CINC,$CIND,$CINFAC + 15 PUBLIC $C8IA,$C8IB,$C8IC,$C8ID + 16 PUBLIC $ADCA,$ADCB,$ADC,$V8IA + 17 + 18 EXTRN $SNORM:NEAR, $SRND:NEAR, $OVFL:NEAR, $ERR_FC:NEAR + 19 + 20 ASSUME CS:CODE, DS:DC, ES:DC + 21 + 22 0000 CONV PROC FAR + 23 + 24 0000 $CDPA: + 25 ;Convert SP at [SI] to DP in FAC + 26 0000 57 PUSH DI + 27 0001 BF 0000 E MOV DI,OFFSET DC:$AC + 28 0004 A5 MOVSW ;Copy to FAC + 29 0005 A5 MOVSW + 30 0006 5F POP DI + 31 0007 83 EE 04 SUB SI,4 + 32 000A $CDPB: + 33 ;Convert SP in FAC to DP + 34 000A C7 06 0000 E 0000 MOV [$DAC],0 + 35 0010 C7 06 0002 E 0000 MOV [$DAC+2],0 + 36 0016 CB RET + 37 + 38 0017 $CISA: + 39 ;Convert integer in BX to SP + 40 0017 $CIDA: + 41 ;Convert integer in BX to DP + 42 0017 53 PUSH BX + 43 0018 52 PUSH DX + 44 0019 50 PUSH AX + 45 001A B8 9000 MOV AX,9000H ;Set exponent to 16 + 46 001D 0A C7 OR AL,BH ;Get sign + 47 001F 79 02 JNS POS ;Already positive + 48 0021 F7 DB NEG BX ;Need magnitude + 49 0023 POS: + 50 0023 33 D2 XOR DX,DX + 51 0025 E8 0000 E CALL $SNORM + 52 0028 58 POP AX + 53 0029 5A POP DX + 54 002A 5B POP BX + + +CONV - Conversions between single, double, and integer Macro-86 %1(12) 0:59:2 13-Nov-81 Page 1-2 + + + + 55 002B EB DD JMP $CDPB ;Convert to DP just in case + 56 + 57 002D $CSPA: + 58 ;Convert DP at [SI] to SP in FAC + 59 002D 57 PUSH DI + 60 002E BF 0000 E MOV DI,OFFSET $DAC + 61 0031 A5 MOVSW + 62 0032 A5 MOVSW + 63 0033 A5 MOVSW + 64 0034 A5 MOVSW + 65 0035 5F POP DI + 66 0036 83 EE 08 SUB SI,8 + 67 0039 $CSPB: + 68 ;Convert DP in FAC to SP + 69 0039 53 PUSH BX + 70 003A 52 PUSH DX + 71 003B 50 PUSH AX + 72 003C 8B 1E FFFE E MOV BX,[$FAC-2] + 73 0040 80 CF 80 OR BH,80H ;Set implied bit + 74 0043 8B 16 FFFC E MOV DX,[$FAC-4] + 75 0047 A1 0000 E MOV AX,[$DAC] + 76 004A 0A C4 OR AL,AH ;OR together all insignificant bits + 77 004C 0A 06 0002 E OR AL,[$DAC+2] + 78 0050 74 03 JZ NOSTICK + 79 0052 80 CA 01 OR DL,1 ;Set sticky bit if any were one + 80 0055 NOSTICK: + 81 0055 A1 FFFF E MOV AX,[$FAC-1] ;Get sign and exponent + 82 0058 E8 0000 E CALL $SRND + 83 005B 58 POP AX + 84 005C 5A POP DX + 85 005D 5B POP BX + 86 005E CB RET + 87 + 88 + 89 ;*** CINT - Round real to integer + 90 ; + 91 ; Inputs: + 92 ; Single or double precision number in FAC or at [SI] + 93 ; Function: + 94 ; Convert by rounding to integer + 95 ; Outputs: + 96 ; BX = FAC = rounded integer + 97 ; Registers: + 98 ; Only BX and F affected. + 99 + 100 005F $C8IA: + 101 005F $CINA: ;Single precision, operand at [SI] + 102 005F 89 26 0000 E MOV [$$SPSV],SP + 103 0063 50 PUSH AX + 104 0064 51 PUSH CX + 105 0065 8B 44 02 MOV AX,[SI+2] ;Get exponent + 106 0068 8B 0C MOV CX,[SI] ;Get mantissa + 107 006A EB 1B JMP SHORT CINT + 108 + + +CONV - Conversions between single, double, and integer Macro-86 %1(12) 0:59:2 13-Nov-81 Page 1-3 + + + + 109 006C $C8IB: + 110 006C $CINB: ;Double precision, operand at [SI] + 111 006C 89 26 0000 E MOV [$$SPSV],SP + 112 0070 50 PUSH AX + 113 0071 51 PUSH CX + 114 0072 8B 44 06 MOV AX,[SI+6] ;Get exponent + 115 0075 8B 4C 04 MOV CX,[SI+4] ;Get mantissa + 116 0078 EB 0D JMP SHORT CINT + 117 + 118 007A $C8IC: + 119 007A $C8ID: + 120 007A $CINC: ;Single precision, operand in FAC + 121 007A $CIND: ;Double precision uses same routine + 122 007A 89 26 0000 E MOV [$$SPSV],SP + 123 007E $CINFAC: + 124 007E 50 PUSH AX + 125 007F 51 PUSH CX + 126 0080 A1 0002 E MOV AX,[$AC+2] ;Get exponent + 127 0083 8B 0E 0000 E MOV CX,[$AC] ;Get mantissa + 128 0087 CINT: + 129 0087 33 DB XOR BX,BX ;Set up zero result + 130 0089 80 EC 80 SUB AH,80H ;Take bias out of exponent + 131 008C 72 23 JB CXRET ;Return zero if no integer part + 132 008E 8A F8 MOV BH,AL ;Highest byte of mantissa + 133 0090 8A DD MOV BL,CH + 134 0092 91 XCHG AX,CX + 135 0093 B1 10 MOV CL,16 + 136 0095 2A CD SUB CL,CH ;Number of bits to shift mantissa right + 137 0097 8A E7 MOV AH,BH ;Save sign + 138 0099 72 27 JB OVERFLOW ;If negative shift, it won't fit in 16 bits + 139 009B 74 1B JZ OVCHK ;Only -32768 has 16 bits - go check for it + 140 009D 80 CF 80 OR BH,80H ;Set implied bit + 141 00A0 D3 EB SHR BX,CL ;Position the integer + 142 00A2 83 D3 00 ADC BX,0 ;Perform rounding + 143 00A5 0A E4 OR AH,AH ;Check sign now + 144 00A7 79 02 JNS NOTNEG + 145 00A9 F7 DB NEG BX + 146 00AB NOTNEG: + 147 00AB F6 D4 NOT AH ;Bit 7 set if positive + 148 00AD 22 E7 AND AH,BH ;Bit 7 set if number positive, >=32768 + 149 00AF 78 11 JS OVERFLOW + 150 00B1 CXRET: + 151 00B1 59 POP CX + 152 00B2 58 POP AX + 153 00B3 89 1E 0000 E MOV [$AC],BX ;Result in both FAC and BX + 154 00B7 CB RET + 155 + 156 00B8 OVCHK: + 157 ;Come here if no shift is needed on the number, i.e., it requires a full + 158 ;16 bits. Only -32768 (8000H) is allowed. + 159 00B8 81 FB 8000 CMP BX,8000H ;The 1 is sign bit (negative), not implied bit + 160 00BC 75 04 JNZ OVERFLOW + 161 00BE A8 80 TEST AL,80H ;Should we be rounding up? + 162 00C0 74 EF JZ CXRET ;If so, that causes overflow + + +CONV - Conversions between single, double, and integer Macro-86 %1(12) 0:59:2 13-Nov-81 Page 1-4 + + + + 163 00C2 OVERFLOW: + 164 00C2 E9 0000 E JMP $OVFL + 165 + 166 + 167 ;*** $ADCA, $ADCB - Convert SP to address + 168 ; + 169 ; Inputs: + 170 ; SI = Address of SP number ($ADCA only) + 171 ; FAC = SP number ($ADCB only) + 172 ; Function: + 173 ; Convert to 16-bit integer in range -32768 to +65535, with rounding. + 174 ; Outputs: + 175 ; Result in BX. + 176 ; Registers: + 177 ; Only BX and F affected. + 178 + 179 00C5 $ADCA: + 180 00C5 89 26 0000 E MOV [$$SPSV],SP + 181 00C9 $ADC: + 182 00C9 50 PUSH AX + 183 00CA 51 PUSH CX + 184 00CB 8B 44 02 MOV AX,[SI+2] ;Get exponent + 185 00CE 8B 0C MOV CX,[SI] ;Get mantissa + 186 00D0 EB 0D JMP SHORT ADDR + 187 + 188 00D2 $ADCB: + 189 00D2 89 26 0000 E MOV [$$SPSV],SP + 190 00D6 50 PUSH AX + 191 00D7 51 PUSH CX + 192 00D8 A1 0002 E MOV AX,[$AC+2] ;Get exponent + 193 00DB 8B 0E 0000 E MOV CX,[$AC] ;Get mantissa + 194 00DF ADDR: + 195 00DF 80 FC 90 CMP AH,90H ;In range 32768-65535? + 196 00E2 75 A3 JNZ CINT ;If not, CINT can do it + 197 00E4 0A C0 OR AL,AL ;Is it negative? + 198 00E6 78 9F JS CINT ;If so, same as CINT + 199 ;Have a positive number range 32768-65536. + 200 00E8 0C 80 OR AL,80H ;Set implied bit + 201 00EA 8A F8 MOV BH,AL + 202 00EC 8A DD MOV BL,CH ;Integer now in BX + 203 00EE D0 E1 SHL CL,1 ;Need to round up? + 204 00F0 83 D3 00 ADC BX,0 + 205 00F3 73 BC JNC CXRET + 206 00F5 E9 0000 E JMP $OVFL + 207 + 208 00F8 $V8IA: + 209 00F8 0A FF OR BH,BH + 210 00FA 75 01 JNZ FARG + 211 00FC CB RET + 212 00FD E9 0000 E FARG: JMP $ERR_FC + 213 + 214 0100 CONV ENDP + 215 0100 CODE ENDS + 216 END + + +CONV - Conversions between single, double, and integer Macro-86 %1(12) 0:59:2 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0100 WORD PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ADDR . . . . . . . . . . . . . . L NEAR 00DF CODE +CINT . . . . . . . . . . . . . . L NEAR 0087 CODE +CONV . . . . . . . . . . . . . . F PROC 0000 CODE Length =0100 +CXRET. . . . . . . . . . . . . . L NEAR 00B1 CODE +FARG . . . . . . . . . . . . . . L NEAR 00FD CODE +NOSTICK. . . . . . . . . . . . . L NEAR 0055 CODE +NOTNEG . . . . . . . . . . . . . L NEAR 00AB CODE +OVCHK. . . . . . . . . . . . . . L NEAR 00B8 CODE +OVERFLOW . . . . . . . . . . . . L NEAR 00C2 CODE +POS. . . . . . . . . . . . . . . L NEAR 0023 CODE +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ADC . . . . . . . . . . . . . . L NEAR 00C9 CODE Global +$ADCA. . . . . . . . . . . . . . L NEAR 00C5 CODE Global +$ADCB. . . . . . . . . . . . . . L NEAR 00D2 CODE Global +$C8IA. . . . . . . . . . . . . . L NEAR 005F CODE Global +$C8IB. . . . . . . . . . . . . . L NEAR 006C CODE Global +$C8IC. . . . . . . . . . . . . . L NEAR 007A CODE Global +$C8ID. . . . . . . . . . . . . . L NEAR 007A CODE Global +$CDPA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$CDPB. . . . . . . . . . . . . . L NEAR 000A CODE Global +$CIDA. . . . . . . . . . . . . . L NEAR 0017 CODE Global +$CINA. . . . . . . . . . . . . . L NEAR 005F CODE Global +$CINB. . . . . . . . . . . . . . L NEAR 006C CODE Global +$CINC. . . . . . . . . . . . . . L NEAR 007A CODE Global +$CIND. . . . . . . . . . . . . . L NEAR 007A CODE Global +$CINFAC. . . . . . . . . . . . . L NEAR 007E CODE Global +$CISA. . . . . . . . . . . . . . L NEAR 0017 CODE Global +$CSPA. . . . . . . . . . . . . . L NEAR 002D CODE Global +$CSPB. . . . . . . . . . . . . . L NEAR 0039 CODE Global +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$ERR_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$OVFL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SNORM . . . . . . . . . . . . . L NEAR 0000 CODE External +$SRND. . . . . . . . . . . . . . L NEAR 0000 CODE External +$V8IA. . . . . . . . . . . . . . L NEAR 00F8 CODE Global + +Warning Severe +Errors Errors +0 0 + + + diff --git a/3_source_code/BASLIB-86/CONV.ASM b/3_source_code/BASLIB-86/CONV.ASM new file mode 100644 index 0000000..fc07247 --- /dev/null +++ b/3_source_code/BASLIB-86/CONV.ASM @@ -0,0 +1,216 @@ + TITLE CONV - Conversions between single, double, and integer + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:WORD, $AC:WORD, $DAC:WORD, $$SPSV:WORD + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT WORD PUBLIC 'CODE' + + PUBLIC $CDPA,$CDPB,$CISA,$CIDA,$CSPA,$CSPB + PUBLIC $CINA,$CINB,$CINC,$CIND,$CINFAC + PUBLIC $C8IA,$C8IB,$C8IC,$C8ID + PUBLIC $ADCA,$ADCB,$ADC,$V8IA + + EXTRN $SNORM:NEAR, $SRND:NEAR, $OVFL:NEAR, $ERR_FC:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +CONV PROC FAR + +$CDPA: +;Convert SP at [SI] to DP in FAC + PUSH DI + MOV DI,OFFSET DC:$AC + MOVSW ;Copy to FAC + MOVSW + POP DI + SUB SI,4 +$CDPB: +;Convert SP in FAC to DP + MOV [$DAC],0 + MOV [$DAC+2],0 + RET + +$CISA: +;Convert integer in BX to SP +$CIDA: +;Convert integer in BX to DP + PUSH BX + PUSH DX + PUSH AX + MOV AX,9000H ;Set exponent to 16 + OR AL,BH ;Get sign + JNS POS ;Already positive + NEG BX ;Need magnitude +POS: + XOR DX,DX + CALL $SNORM + POP AX + POP DX + POP BX + JMP $CDPB ;Convert to DP just in case + +$CSPA: +;Convert DP at [SI] to SP in FAC + PUSH DI + MOV DI,OFFSET $DAC + MOVSW + MOVSW + MOVSW + MOVSW + POP DI + SUB SI,8 +$CSPB: +;Convert DP in FAC to SP + PUSH BX + PUSH DX + PUSH AX + MOV BX,[$FAC-2] + OR BH,80H ;Set implied bit + MOV DX,[$FAC-4] + MOV AX,[$DAC] + OR AL,AH ;OR together all insignificant bits + OR AL,[$DAC+2] + JZ NOSTICK + OR DL,1 ;Set sticky bit if any were one +NOSTICK: + MOV AX,[$FAC-1] ;Get sign and exponent + CALL $SRND + POP AX + POP DX + POP BX + RET + + +;*** CINT - Round real to integer +; +; Inputs: +; Single or double precision number in FAC or at [SI] +; Function: +; Convert by rounding to integer +; Outputs: +; BX = FAC = rounded integer +; Registers: +; Only BX and F affected. + +$C8IA: +$CINA: ;Single precision, operand at [SI] + MOV [$$SPSV],SP + PUSH AX + PUSH CX + MOV AX,[SI+2] ;Get exponent + MOV CX,[SI] ;Get mantissa + JMP SHORT CINT + +$C8IB: +$CINB: ;Double precision, operand at [SI] + MOV [$$SPSV],SP + PUSH AX + PUSH CX + MOV AX,[SI+6] ;Get exponent + MOV CX,[SI+4] ;Get mantissa + JMP SHORT CINT + +$C8IC: +$C8ID: +$CINC: ;Single precision, operand in FAC +$CIND: ;Double precision uses same routine + MOV [$$SPSV],SP +$CINFAC: + PUSH AX + PUSH CX + MOV AX,[$AC+2] ;Get exponent + MOV CX,[$AC] ;Get mantissa +CINT: + XOR BX,BX ;Set up zero result + SUB AH,80H ;Take bias out of exponent + JB CXRET ;Return zero if no integer part + MOV BH,AL ;Highest byte of mantissa + MOV BL,CH + XCHG AX,CX + MOV CL,16 + SUB CL,CH ;Number of bits to shift mantissa right + MOV AH,BH ;Save sign + JB OVERFLOW ;If negative shift, it won't fit in 16 bits + JZ OVCHK ;Only -32768 has 16 bits - go check for it + OR BH,80H ;Set implied bit + SHR BX,CL ;Position the integer + ADC BX,0 ;Perform rounding + OR AH,AH ;Check sign now + JNS NOTNEG + NEG BX +NOTNEG: + NOT AH ;Bit 7 set if positive + AND AH,BH ;Bit 7 set if number positive, >=32768 + JS OVERFLOW +CXRET: + POP CX + POP AX + MOV [$AC],BX ;Result in both FAC and BX + RET + +OVCHK: +;Come here if no shift is needed on the number, i.e., it requires a full +;16 bits. Only -32768 (8000H) is allowed. + CMP BX,8000H ;The 1 is sign bit (negative), not implied bit + JNZ OVERFLOW + TEST AL,80H ;Should we be rounding up? + JZ CXRET ;If so, that causes overflow +OVERFLOW: + JMP $OVFL + + +;*** $ADCA, $ADCB - Convert SP to address +; +; Inputs: +; SI = Address of SP number ($ADCA only) +; FAC = SP number ($ADCB only) +; Function: +; Convert to 16-bit integer in range -32768 to +65535, with rounding. +; Outputs: +; Result in BX. +; Registers: +; Only BX and F affected. + +$ADCA: + MOV [$$SPSV],SP +$ADC: + PUSH AX + PUSH CX + MOV AX,[SI+2] ;Get exponent + MOV CX,[SI] ;Get mantissa + JMP SHORT ADDR + +$ADCB: + MOV [$$SPSV],SP + PUSH AX + PUSH CX + MOV AX,[$AC+2] ;Get exponent + MOV CX,[$AC] ;Get mantissa +ADDR: + CMP AH,90H ;In range 32768-65535? + JNZ CINT ;If not, CINT can do it + OR AL,AL ;Is it negative? + JS CINT ;If so, same as CINT +;Have a positive number range 32768-65536. + OR AL,80H ;Set implied bit + MOV BH,AL + MOV BL,CH ;Integer now in BX + SHL CL,1 ;Need to round up? + ADC BX,0 + JNC CXRET + JMP $OVFL + +$V8IA: + OR BH,BH + JNZ FARG + RET +FARG: JMP $ERR_FC + +CONV ENDP +CODE ENDS + END From faddab947857daf3c054c1d12f896ee69cc67d82 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sun, 14 Jun 2026 14:44:00 -0700 Subject: [PATCH 07/53] Transcription of Bundle 9 - DATAN.ASM Code and Listing --- 2_printed_files/bundle_09/DATAN.ASM | 239 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DATAN.ASM | 123 ++++++++++++++ 2 files changed, 362 insertions(+) create mode 100644 2_printed_files/bundle_09/DATAN.ASM create mode 100644 3_source_code/BASLIB-86/DATAN.ASM diff --git a/2_printed_files/bundle_09/DATAN.ASM b/2_printed_files/bundle_09/DATAN.ASM new file mode 100644 index 0000000..7cf32d0 --- /dev/null +++ b/2_printed_files/bundle_09/DATAN.ASM @@ -0,0 +1,239 @@ +DATAN - Double precision arc tangent Macro-86 %1(12) 0:59:12 13-Nov-81 Page 1-1 + + + 1 TITLE DATAN - Double precision arc tangent + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:BYTE, $DAC:WORD, $ARG:WORD, $TEMP:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 10 + 11 EXTRN $DBLONE:WORD,$DHALFPI:WORD,$DSIXTHPI:WORD,$DSQRT3:WORD + 12 EXTRN $DTANTWELFTHPI:WORD + 13 + 14 ;Coefficients for Hart's 4945. Relative error 16.82, range [0,TAN(PI/12)]. + 15 ;ATAN(x) = xP(x^2) + 16 ; These constants have been checked with MuMath + 17 + 18 0000 0008 ATANTAB DW 8 ;Degree + 19 0002 18 E6 C0 E4 C7 D1 DB 018H,0E6H,0C0H,0E4H,0C7H,0D1H,035H,07CH ;+0.0443895157187 + 20 35 7C + 21 000A 0B 01 08 08 9B C6 DB 00BH,001H,008H,008H,09BH,0C6H,084H,07DH ;-0.06483193510303 + 22 84 7D + 23 0012 26 C5 6C 2E 02 46 DB 026H,0C5H,06CH,02EH,002H,046H,01DH,07DH ;+0.0767936869066 + 24 1D 7D + 25 001A 98 6B 0A 9D B9 2B DB 098H,06BH,00AH,09DH,0B9H,02BH,0BAH,07DH ;-0.0909037114191074 + 26 BA 7D + 27 0022 01 2B 95 27 27 8E DB 001H,02BH,095H,027H,027H,08EH,063H,07DH ;+0.11111097898051048 + 28 63 7D + 29 002A 6A 9C DD 72 24 49 DB 06AH,09CH,0DDH,072H,024H,049H,092H,07EH ;-0.142857141028255452 + 30 92 7E + 31 0032 A8 EB 94 CC CC CC DB 0A8H,0EBH,094H,0CCH,0CCH,0CCH,04CH,07EH ;+0.1999999999872944792 + 32 4C 7E + 33 003A 83 97 AA AA AA AA DB 083H,097H,0AAH,0AAH,0AAH,0AAH,0AAH,07FH ;-0.333333333333299308717 + 34 AA 7F + 35 0042 FF FF FF FF FF FF DB 0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,07FH,080H ;+0.9999999999999999849899 + 36 7F 80 + 37 + 38 004A CONST ENDS + 39 + 40 + 41 DC GROUP DATA,CONST + 42 + 43 + 44 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 45 + 46 PUBLIC $ATD + 47 + 48 EXTRN $SAVREG:NEAR, $DPOLYX:NEAR + 49 EXTRN $DDIV:NEAR, $DMUL:NEAR, $DADD:NEAR, $DSUB:NEAR, $DCMP:NEAR + 50 + 51 ASSUME CS:CODE, DS:DC, ES:DC + 52 + 53 + 54 ;$ATD - Arc tangent + + +DATAN - Double precision arc tangent Macro-86 %1(12) 0:59:12 13-Nov-81 Page 1-2 + + + + 55 ; + 56 ; Inputs: + 57 ; BX = Address of argument + 58 ; Outputs: + 59 ; Result in FAC + 60 ; Registers: + 61 ; Only F affected. + 62 + 63 0000 $ATD: + 64 0000 E8 0000 E CALL $SAVREG + 65 0003 8B F3 MOV SI,BX + 66 0005 BF 0000 E MOV DI,OFFSET DC:$DAC + 67 0008 A5 MOVSW ;Put in FAC + 68 0009 A5 MOVSW + 69 000A A5 MOVSW + 70 000B AD LODSW + 71 000C AB STOSW + 72 000D 0A E4 OR AH,AH ;Is it zero? + 73 000F 74 11 JZ DONE ;If so, result is too + 74 0011 A8 80 TEST AL,80H ;Check sign + 75 0013 79 0E JNS POSATAN + 76 0015 24 7F AND AL,7FH + 77 0017 A2 FFFF E MOV [$FAC-1],AL ;Make it positive + 78 001A E8 0023 R CALL POSATAN ;Take arctan of positive number + 79 001D 80 36 FFFF E 80 XOR [$FAC-1],80H ;Invert sign back + 80 0022 C3 DONE: RET + 81 + 82 0023 POSATAN: + 83 0023 80 FC 81 CMP AH,81H ;Is it >= 1? + 84 0026 72 15 JB LESSTHAN1 + 85 0028 BE 0000 E MOV SI,OFFSET DC:$DBLONE + 86 002B BF 0000 E MOV DI,OFFSET DC:$DAC + 87 002E E8 0000 E CALL $DDIV ;It's reciprocal is < 1 + 88 0031 E8 003D R CALL LESSTHAN1 ;Compute arc-cotan on number < 1 + 89 0034 BE 0000 E MOV SI,OFFSET DC:$DHALFPI + 90 0037 BF 0000 E MOV DI,OFFSET DC:$DAC + 91 003A E9 0000 E JMP $DSUB ;Correct by subtracting from PI/2 + 92 + 93 003D LESSTHAN1: + 94 003D BE 0000 E MOV SI,OFFSET DC:$DTANTWELFTHPI + 95 0040 BF 0000 E MOV DI,OFFSET DC:$DAC + 96 0043 E8 0000 E CALL $DCMP ;Compare argument to PI/12 + 97 0046 73 44 JAE DOATAN ;Range reduction complete if <= PI/12 + 98 0048 BE 0000 E MOV SI,OFFSET DC:$DAC + 99 004B BF 0000 E MOV DI,OFFSET DC:$ARG + 100 004E A5 MOVSW ;Save X in ARG + 101 004F A5 MOVSW + 102 0050 A5 MOVSW + 103 0051 A5 MOVSW + 104 0052 BE 0000 E MOV SI,OFFSET DC:$DSQRT3 ;Point to TAN(PI/6) (PI/6 = 30 degrees) + 105 0055 BF 0000 E MOV DI,OFFSET DC:$DAC + 106 0058 E8 0000 E CALL $DADD ;FAC = X + TAN(PI/6) + 107 005B BE 0000 E MOV SI,OFFSET DC:$DAC + 108 005E BF 0000 E MOV DI,OFFSET DC:$TEMP + + +DATAN - Double precision arc tangent Macro-86 %1(12) 0:59:12 13-Nov-81 Page 1-3 + + + + 109 0061 A5 MOVSW ;Save it in TEMP + 110 0062 A5 MOVSW + 111 0063 A5 MOVSW + 112 0064 A5 MOVSW + 113 0065 BE 0000 E MOV SI,OFFSET DC:$DSQRT3 + 114 0068 BF 0000 E MOV DI,OFFSET DC:$ARG + 115 006B E8 0000 E CALL $DMUL ;FAC = X * TAN(PI/6) + 116 006E BE 0000 E MOV SI,OFFSET DC:$DAC + 117 0071 BF 0000 E MOV DI,OFFSET DC:$DBLONE + 118 0074 E8 0000 E CALL $DSUB ;FAC = X * TAN(PI/6) - 1 + 119 0077 BE 0000 E MOV SI,OFFSET DC:$DAC + 120 007A BF 0000 E MOV DI,OFFSET DC:$TEMP + 121 007D E8 0000 E CALL $DDIV ;FAC = (X*TAN(PI/6) - 1)/(X + TAN(PI/6) + 122 0080 E8 008C R CALL DOATAN ;Compute arctan on argument < PI/12 + 123 0083 BE 0000 E MOV SI,OFFSET DC:$DSIXTHPI + 124 0086 BF 0000 E MOV DI,OFFSET DC:$DAC + 125 0089 E9 0000 E JMP $DADD ;Correct for range reduction by adding PI/6 + 126 + 127 008C DOATAN: + 128 008C BB 0000 R MOV BX,OFFSET DC:ATANTAB + 129 008F E9 0000 E JMP $DPOLYX + 130 + 131 0092 CODE ENDS + 132 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DATAN - Double precision arc tangent Macro-86 %1(12) 0:59:12 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0092 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 004A WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +ATANTAB. . . . . . . . . . . . . L WORD 0000 CONST +DOATAN . . . . . . . . . . . . . L NEAR 008C CODE +DONE . . . . . . . . . . . . . . L NEAR 0022 CODE +LESSTHAN1. . . . . . . . . . . . L NEAR 003D CODE +POSATAN. . . . . . . . . . . . . L NEAR 0023 CODE +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$ATD . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DBLONE. . . . . . . . . . . . . V WORD 0000 CONST External +$DCMP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DHALFPI . . . . . . . . . . . . V WORD 0000 CONST External +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DPOLYX. . . . . . . . . . . . . L NEAR 0000 CODE External +$DSIXTHPI. . . . . . . . . . . . V WORD 0000 CONST External +$DSQRT3. . . . . . . . . . . . . V WORD 0000 CONST External +$DSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DTANTWELFTHPI . . . . . . . . . V WORD 0000 CONST External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/DATAN.ASM b/3_source_code/BASLIB-86/DATAN.ASM new file mode 100644 index 0000000..c50f2ec --- /dev/null +++ b/3_source_code/BASLIB-86/DATAN.ASM @@ -0,0 +1,123 @@ + TITLE DATAN - Double precision arc tangent + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE, $DAC:WORD, $ARG:WORD, $TEMP:WORD + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $DBLONE:WORD,$DHALFPI:WORD,$DSIXTHPI:WORD,$DSQRT3:WORD + EXTRN $DTANTWELFTHPI:WORD + +;Coefficients for Hart's 4945. Relative error 16.82, range [0,TAN(PI/12)]. +;ATAN(x) = xP(x^2) +; These constants have been checked with MuMath + +ATANTAB DW 8 ;Degree + DB 018H,0E6H,0C0H,0E4H,0C7H,0D1H,035H,07CH ;+0.0443895157187 + DB 00BH,001H,008H,008H,09BH,0C6H,084H,07DH ;-0.06483193510303 + DB 026H,0C5H,06CH,02EH,002H,046H,01DH,07DH ;+0.0767936869066 + DB 098H,06BH,00AH,09DH,0B9H,02BH,0BAH,07DH ;-0.0909037114191074 + DB 001H,02BH,095H,027H,027H,08EH,063H,07DH ;+0.11111097898051048 + DB 06AH,09CH,0DDH,072H,024H,049H,092H,07EH ;-0.142857141028255452 + DB 0A8H,0EBH,094H,0CCH,0CCH,0CCH,04CH,07EH ;+0.1999999999872944792 + DB 083H,097H,0AAH,0AAH,0AAH,0AAH,0AAH,07FH ;-0.333333333333299308717 + DB 0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,07FH,080H ;+0.9999999999999999849899 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $ATD + + EXTRN $SAVREG:NEAR, $DPOLYX:NEAR + EXTRN $DDIV:NEAR, $DMUL:NEAR, $DADD:NEAR, $DSUB:NEAR, $DCMP:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;$ATD - Arc tangent +; +; Inputs: +; BX = Address of argument +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$ATD: + CALL $SAVREG + MOV SI,BX + MOV DI,OFFSET DC:$DAC + MOVSW ;Put in FAC + MOVSW + MOVSW + LODSW + STOSW + OR AH,AH ;Is it zero? + JZ DONE ;If so, result is too + TEST AL,80H ;Check sign + JNS POSATAN + AND AL,7FH + MOV [$FAC-1],AL ;Make it positive + CALL POSATAN ;Take arctan of positive number + XOR [$FAC-1],80H ;Invert sign back +DONE: RET + +POSATAN: + CMP AH,81H ;Is it >= 1? + JB LESSTHAN1 + MOV SI,OFFSET DC:$DBLONE + MOV DI,OFFSET DC:$DAC + CALL $DDIV ;It's reciprocal is < 1 + CALL LESSTHAN1 ;Compute arc-cotan on number < 1 + MOV SI,OFFSET DC:$DHALFPI + MOV DI,OFFSET DC:$DAC + JMP $DSUB ;Correct by subtracting from PI/2 + +LESSTHAN1: + MOV SI,OFFSET DC:$DTANTWELFTHPI + MOV DI,OFFSET DC:$DAC + CALL $DCMP ;Compare argument to PI/12 + JAE DOATAN ;Range reduction complete if <= PI/12 + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG + MOVSW ;Save X in ARG + MOVSW + MOVSW + MOVSW + MOV SI,OFFSET DC:$DSQRT3 ;Point to TAN(PI/6) (PI/6 = 30 degrees) + MOV DI,OFFSET DC:$DAC + CALL $DADD ;FAC = X + TAN(PI/6) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + MOVSW ;Save it in TEMP + MOVSW + MOVSW + MOVSW + MOV SI,OFFSET DC:$DSQRT3 + MOV DI,OFFSET DC:$ARG + CALL $DMUL ;FAC = X * TAN(PI/6) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$DBLONE + CALL $DSUB ;FAC = X * TAN(PI/6) - 1 + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + CALL $DDIV ;FAC = (X*TAN(PI/6) - 1)/(X + TAN(PI/6) + CALL DOATAN ;Compute arctan on argument < PI/12 + MOV SI,OFFSET DC:$DSIXTHPI + MOV DI,OFFSET DC:$DAC + JMP $DADD ;Correct for range reduction by adding PI/6 + +DOATAN: + MOV BX,OFFSET DC:ATANTAB + JMP $DPOLYX + +CODE ENDS + END From b3b2cb8afea32ec507c53e1f38c05cb882bd25ef Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Mon, 15 Jun 2026 17:09:55 -0700 Subject: [PATCH 08/53] Transcription of Bundle 9 - DEXP.ASM Code and Listing --- 2_printed_files/bundle_09/DEXP.ASM | 240 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DEXP.ASM | 150 ++++++++++++++++++ 2 files changed, 390 insertions(+) create mode 100644 2_printed_files/bundle_09/DEXP.ASM create mode 100644 3_source_code/BASLIB-86/DEXP.ASM diff --git a/2_printed_files/bundle_09/DEXP.ASM b/2_printed_files/bundle_09/DEXP.ASM new file mode 100644 index 0000000..0711eff --- /dev/null +++ b/2_printed_files/bundle_09/DEXP.ASM @@ -0,0 +1,240 @@ +DEXP - Double precision exponential function Macro-86 %1(12) 0:59:20 13-Nov-81 Page 1-1 + + + + 1 TITLE DEXP - Double precision exponential function + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:BYTE, $DAC:WORD, $ARG:WORD, $TEMP:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 + 10 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 11 + 12 EXTRN $DBLONE:WORD, $DLOG2E:WORD + 13 + 14 ;Coefficients for Hart's 1323, relative error 17.26, range [0,1/2]. + 15 ; 2^x = 1 + 2xP(x^2) / [Q(x^2) - xP(x^2)] + 16 ; These constants have been checked with MuMath + 17 + 18 0000 0002 PTAB DW 2 ;Degree + 19 0002 04 A3 E6 52 4D 30 DB 004H,0A3H,0E6H,052H,04DH,030H,03DH,07BH ;+0.02309432127295385660455 + 20 3D 7B + 21 000A B2 BB AB E4 14 9D DB 0B2H,0BBH,0ABH,0E4H,014H,09DH,021H,085H ;+20.20170000695312603946477 + 22 21 85 + 23 0012 91 9E 3B 4E A7 3B DB 091H,09EH,03BH,04EH,0A7H,03BH,03DH,08BH ;+1513.86417304653561981057161 + 24 3D 8B + 25 + 26 001A 0002 QTAB DW 2 ;Degree + 27 001C 00 00 00 00 00 00 DB 000H,000H,000H,000H,000H,000H,000H,081H ;+1 + 28 00 81 + 29 0024 CB FE 9F 9D A0 2D DB 0CBH,0FEH,09FH,09DH,0A0H,02DH,069H,088H ;+233.17823205143103579679705 + 30 69 88 + 31 002C 85 FD A6 98 B5 80 DB 085H,0FDH,0A6H,098H,0B5H,080H,008H,08DH ;+4368.08867006741698646914202 + 32 08 8D + 33 + 34 0034 CONST ENDS + 35 + 36 + 37 DC GROUP DATA,CONST + 38 + 39 + 40 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 41 + 42 PUBLIC $EXD,$DEXP + 43 + 44 EXTRN $DPOLY2:NEAR, $DPOLYX:NEAR, $SAVREG:NEAR + 45 EXTRN $DDIV:NEAR, $DADD:NEAR, $DMUL:NEAR, $DSUB:NEAR + 46 EXTRN $IND:FAR, $OVFL:NEAR, $PUT1D:NEAR + 47 + 48 ASSUME CS:CODE, DS:DC, ES:DC + 49 + 50 + 51 0000 ONE: + 52 ;Argument is too small. Jam result to one. + 53 0000 E9 0000 E JMP $PUT1D + 54 + + +DEXP - Double precision exponential function Macro-86 %1(12) 0:59:20 13-Nov-81 Page 1-2 + + + + 55 0003 NOPOLY: + 56 0003 E8 0000 E CALL $PUT1D + 57 0006 E9 00A8 R JMP FIGEXP + 58 + 59 0009 E9 00C1 R OVERCHKJ:JMP OVERCHK + 60 + 61 ;*** $EXD - Exponential (base e) function + 62 ; + 63 ; Inputs: + 64 ; BX = Address of argument + 65 ; Outputs: + 66 ; Result in FAC + 67 ; Registers: + 68 ; Only F affected. + 69 + 70 000C $EXD: + 71 000C E8 0000 E CALL $SAVREG + 72 000F $DEXP: + 73 000F 8B F3 MOV SI,BX + 74 0011 BF 0000 E MOV DI,OFFSET DC:$DLOG2E ;Log base 2 of e + 75 0014 E8 0000 E CALL $DMUL + 76 0017 BE 0000 E MOV SI,OFFSET DC:$DAC + 77 001A BF 0000 E MOV DI,OFFSET DC:$ARG + 78 001D A5 MOVSW ;Move argument to ARG + 79 001E A5 MOVSW + 80 001F A5 MOVSW + 81 0020 AD LODSW ;Get sign and exponent + 82 0021 AB STOSW + 83 0022 80 FC 88 CMP AH,88H ;True exp. >= 8 means ABS(X) >= 128 + 84 0025 73 E2 JAE OVERCHKJ ; which could cause overflow + 85 0027 80 FC 48 CMP AH,80H-56 ;True exp. < -56 means result is just 1 + 86 002A 72 D4 JB ONE ; since EXP(X)=1+X for X<<1 + 87 002C BB 0000 E MOV BX,OFFSET DC:$DAC + 88 002F 9A 0000 ---- E CALL $IND ;Perform FLOOR function + 89 0034 FF 36 0006 E PUSH [$DAC+6] ;Save so we can convert to 1-byte integer + 90 0038 BE 0000 E MOV SI,OFFSET DC:$ARG + 91 003B BF 0000 E MOV DI,OFFSET DC:$DAC + 92 003E E8 0000 E CALL $DSUB ;FAC = X - INT(X) --> FAC>=0 + 93 0041 A0 0000 E MOV AL,[$FAC] + 94 0044 2C 01 SUB AL,1 ;FAC = FAC/2, carry set if underflow + 95 0046 76 BB JBE NOPOLY + 96 0048 A2 0000 E MOV [$FAC],AL + 97 004B FF 36 0000 E PUSH [$DAC] ;Save reduced X (range [0,1/2]) + 98 004F FF 36 0002 E PUSH [$DAC+2] + 99 0053 FF 36 0004 E PUSH [$DAC+4] + 100 0057 FF 36 0006 E PUSH [$DAC+6] + 101 005B BB 0000 R MOV BX,OFFSET DC:PTAB + 102 005E E8 0000 E CALL $DPOLYX ;Compute xP(x^2) + 103 0061 BE 0000 E MOV SI,OFFSET DC:$DAC + 104 0064 BF 0000 E MOV DI,OFFSET DC:$TEMP + 105 0067 A5 MOVSW + 106 0068 A5 MOVSW + 107 0069 A5 MOVSW + 108 006A A5 MOVSW + + +DEXP - Double precision exponential function Macro-86 %1(12) 0:59:20 13-Nov-81 Page 1-3 + + + + 109 006B 8F 06 0006 E POP [$DAC+6] + 110 006F 8F 06 0004 E POP [$DAC+4] + 111 0073 8F 06 0002 E POP [$DAC+2] + 112 0077 8F 06 0000 E POP [$DAC] + 113 007B BB 001A R MOV BX,OFFSET DC:QTAB + 114 007E E8 0000 E CALL $DPOLY2 ;Compute Q(x^2) + 115 0081 BE 0000 E MOV SI,OFFSET DC:$DAC + 116 0084 BF 0000 E MOV DI,OFFSET DC:$TEMP + 117 0087 E8 0000 E CALL $DSUB ;DAC = Q(x^2) - xP(x^2) + 118 008A BE 0000 E MOV SI,OFFSET DC:$TEMP + 119 008D BF 0000 E MOV DI,OFFSET DC:$DAC + 120 0090 E8 0000 E CALL $DDIV ;DAC = xP(x^2) / [Q(x^2) - xP(x^2)] + 121 0093 FE 06 0000 E INC [$FAC] ;DAC = DAC*2 - overflow not possible + 122 0097 BE 0000 E MOV SI,OFFSET DC:$DAC + 123 009A BF 0000 E MOV DI,OFFSET DC:$DBLONE + 124 009D E8 0000 E CALL $DADD ;DAC = DAC + 1 + 125 00A0 BE 0000 E MOV SI,OFFSET DC:$DAC + 126 00A3 8B FE MOV DI,SI + 127 00A5 E8 0000 E CALL $DMUL ;Square to account for divide by two above + 128 00A8 FIGEXP: + 129 00A8 58 POP AX ;Recover INT(X) + 130 00A9 0A E4 OR AH,AH ;Was it zero? + 131 00AB 74 26 JZ RET ;If so, we're done + 132 00AD B1 88 MOV CL,88H + 133 00AF 2A CC SUB CL,AH ;Amount to shift mantissa right to make int. + 134 00B1 98 CBW ;Remember sign + 135 00B2 0C 80 OR AL,80H ;Set implied bit + 136 00B4 D2 E8 SHR AL,CL ;AL now is INT(X) + 137 00B6 0A E4 OR AH,AH ;Check sign + 138 00B8 75 0E JNZ SUBEXP + 139 00BA 00 06 0000 E ADD [$FAC],AL ;Add to exponent + 140 00BE 72 05 JC OVER + 141 00C0 C3 RET + 142 + 143 00C1 OVERCHK: + 144 00C1 0A C0 OR AL,AL ;Positive or negative argument? + 145 00C3 78 09 JS ZERO + 146 00C5 E9 0000 E OVER: JMP $OVFL + 147 + 148 00C8 SUBEXP: + 149 00C8 28 06 0000 E SUB [$FAC],AL + 150 00CC 77 05 JA RET + 151 00CE ZERO: + 152 00CE C6 06 0000 E 00 MOV [$FAC],0 ;Underflow - force to zero + 153 00D3 C3 RET: RET + 154 + 155 00D4 CODE ENDS + 156 END + + + + + + + + +DEXP - Double precision exponential function Macro-86 %1(12) 0:59:20 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00D4 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 0034 WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +FIGEXP . . . . . . . . . . . . . L NEAR 00A8 CODE +NOPOLY . . . . . . . . . . . . . L NEAR 0003 CODE +ONE. . . . . . . . . . . . . . . L NEAR 0000 CODE +OVER . . . . . . . . . . . . . . L NEAR 00C5 CODE +OVERCHK. . . . . . . . . . . . . L NEAR 00C1 CODE +OVERCHKJ . . . . . . . . . . . . L NEAR 0009 CODE +PTAB . . . . . . . . . . . . . . L WORD 0000 CONST +QTAB . . . . . . . . . . . . . . L WORD 001A CONST +RET. . . . . . . . . . . . . . . L NEAR 00D3 CODE +SUBEXP . . . . . . . . . . . . . L NEAR 00C8 CODE +ZERO . . . . . . . . . . . . . . L NEAR 00CE CODE +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DBLONE. . . . . . . . . . . . . V WORD 0000 CONST External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DEXP. . . . . . . . . . . . . . L NEAR 000F CODE Global +$DLOG2E. . . . . . . . . . . . . V WORD 0000 CONST External +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DPOLY2. . . . . . . . . . . . . L NEAR 0000 CODE External +$DPOLYX. . . . . . . . . . . . . L NEAR 0000 CODE External +$DSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$EXD . . . . . . . . . . . . . . L NEAR 000C CODE Global +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$IND . . . . . . . . . . . . . . L FAR 0000 CODE External +$OVFL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$PUT1D . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/DEXP.ASM b/3_source_code/BASLIB-86/DEXP.ASM new file mode 100644 index 0000000..d7995f6 --- /dev/null +++ b/3_source_code/BASLIB-86/DEXP.ASM @@ -0,0 +1,150 @@ + TITLE DEXP - Double precision exponential function + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE, $DAC:WORD, $ARG:WORD, $TEMP:WORD + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $DBLONE:WORD, $DLOG2E:WORD + +;Coefficients for Hart's 1323, relative error 17.26, range [0,1/2]. +; 2^x = 1 + 2xP(x^2) / [Q(x^2) - xP(x^2)] +; These constants have been checked with MuMath + +PTAB DW 2 ;Degree + DB 004H,0A3H,0E6H,052H,04DH,030H,03DH,07BH ;+0.02309432127295385660455 + DB 0B2H,0BBH,0ABH,0E4H,014H,09DH,021H,085H ;+20.20170000695312603946477 + DB 091H,09EH,03BH,04EH,0A7H,03BH,03DH,08BH ;+1513.86417304653561981057161 + +QTAB DW 2 ;Degree + DB 000H,000H,000H,000H,000H,000H,000H,081H ;+1 + DB 0CBH,0FEH,09FH,09DH,0A0H,02DH,069H,088H ;+233.17823205143103579679705 + DB 085H,0FDH,0A6H,098H,0B5H,080H,008H,08DH ;+4368.08867006741698646914202 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $EXD,$DEXP + + EXTRN $DPOLY2:NEAR, $DPOLYX:NEAR, $SAVREG:NEAR + EXTRN $DDIV:NEAR, $DADD:NEAR, $DMUL:NEAR, $DSUB:NEAR + EXTRN $IND:FAR, $OVFL:NEAR, $PUT1D:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +ONE: +;Argument is too small. Jam result to one. + JMP $PUT1D + +NOPOLY: + CALL $PUT1D + JMP FIGEXP + +OVERCHKJ:JMP OVERCHK + +;*** $EXD - Exponential (base e) function +; +; Inputs: +; BX = Address of argument +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$EXD: + CALL $SAVREG +$DEXP: + MOV SI,BX + MOV DI,OFFSET DC:$DLOG2E ;Log base 2 of e + CALL $DMUL + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG + MOVSW ;Move argument to ARG + MOVSW + MOVSW + LODSW ;Get sign and exponent + STOSW + CMP AH,88H ;True exp. >= 8 means ABS(X) >= 128 + JAE OVERCHKJ ; which could cause overflow + CMP AH,80H-56 ;True exp. < -56 means result is just 1 + JB ONE ; since EXP(X)=1+X for X<<1 + MOV BX,OFFSET DC:$DAC + CALL $IND ;Perform FLOOR function + PUSH [$DAC+6] ;Save so we can convert to 1-byte integer + MOV SI,OFFSET DC:$ARG + MOV DI,OFFSET DC:$DAC + CALL $DSUB ;FAC = X - INT(X) --> FAC>=0 + MOV AL,[$FAC] + SUB AL,1 ;FAC = FAC/2, carry set if underflow + JBE NOPOLY + MOV [$FAC],AL + PUSH [$DAC] ;Save reduced X (range [0,1/2]) + PUSH [$DAC+2] + PUSH [$DAC+4] + PUSH [$DAC+6] + MOV BX,OFFSET DC:PTAB + CALL $DPOLYX ;Compute xP(x^2) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + MOVSW + MOVSW + MOVSW + MOVSW + POP [$DAC+6] + POP [$DAC+4] + POP [$DAC+2] + POP [$DAC] + MOV BX,OFFSET DC:QTAB + CALL $DPOLY2 ;Compute Q(x^2) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + CALL $DSUB ;DAC = Q(x^2) - xP(x^2) + MOV SI,OFFSET DC:$TEMP + MOV DI,OFFSET DC:$DAC + CALL $DDIV ;DAC = xP(x^2) / [Q(x^2) - xP(x^2)] + INC [$FAC] ;DAC = DAC*2 - overflow not possible + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$DBLONE + CALL $DADD ;DAC = DAC + 1 + MOV SI,OFFSET DC:$DAC + MOV DI,SI + CALL $DMUL ;Square to account for divide by two above +FIGEXP: + POP AX ;Recover INT(X) + OR AH,AH ;Was it zero? + JZ RET ;If so, we're done + MOV CL,88H + SUB CL,AH ;Amount to shift mantissa right to make int. + CBW ;Remember sign + OR AL,80H ;Set implied bit + SHR AL,CL ;AL now is INT(X) + OR AH,AH ;Check sign + JNZ SUBEXP + ADD [$FAC],AL ;Add to exponent + JC OVER + RET + +OVERCHK: + OR AL,AL ;Positive or negative argument? + JS ZERO +OVER: JMP $OVFL + +SUBEXP: + SUB [$FAC],AL + JA RET +ZERO: + MOV [$FAC],0 ;Underflow - force to zero +RET: RET + +CODE ENDS + END From dd5fcefac283c721832d5d8225705f7dc0e13188 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 18 Jun 2026 15:28:57 -0700 Subject: [PATCH 09/53] Transcription of Bundle 9 - DLOG.ASM Code and Listing --- 2_printed_files/bundle_09/DLOG.ASM | 240 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DLOG.ASM | 106 +++++++++++++ 2 files changed, 346 insertions(+) create mode 100644 2_printed_files/bundle_09/DLOG.ASM create mode 100644 3_source_code/BASLIB-86/DLOG.ASM diff --git a/2_printed_files/bundle_09/DLOG.ASM b/2_printed_files/bundle_09/DLOG.ASM new file mode 100644 index 0000000..79dde96 --- /dev/null +++ b/2_printed_files/bundle_09/DLOG.ASM @@ -0,0 +1,240 @@ +DLOG - Double precision natural logarithm Macro-86 %1(12) 0:59:27 13-Nov-81 Page 1-1 + + + + 1 TITLE DLOG - Double precision natural logarithm + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $DAC:WORD, $FAC:BYTE, $ARG:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 + 10 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 11 + 12 EXTRN $DBLONE:WORD, $DHALFLN2:WORD, $DHALFSQR2:WORD + 13 + 14 ;Coefficient tables for Hart's 2665. Absolute error 16.52, + 15 ;range [1/SQRT(2),SQRT(2)]. LOG(x) = zP(z^2), z=(x-1)/(x+1) + 16 ; These constants have been checked with MuMath + 17 + 18 0000 0006 LOGTAB DW 6 ;Degree 6 polynomial + 19 0002 F8 F9 76 DE B8 8C DB 0F8H,0F9H,076H,0DEH,0B8H,08CH,02DH,07EH ;+0.16948212488 + 20 2D 7E + 21 000A 4D 9E CE BF D9 75 DB 04DH,09EH,0CEH,0BFH,0D9H,075H,039H,07EH ;+0.1811136267967 + 22 39 7E + 23 0012 35 BB 41 60 6B 92 DB 035H,0BBH,041H,060H,06BH,092H,063H,07EH ;+0.22223823332791 + 24 63 7E + 25 001A 32 66 C6 0E 1E 49 DB 032H,066H,0C6H,00EH,01EH,049H,012H,07FH ;+0.2857140915904889 + 26 12 7F + 27 0022 FB EB 28 D7 CC CC DB 0FBH,0EBH,028H,0D7H,0CCH,0CCH,04CH,07FH ;+0.400000001206045365 + 28 4C 7F + 29 002A A3 09 A7 AA AA AA DB 0A3H,009H,0A7H,0AAH,0AAH,0AAH,02AH,080H ;+0.6666666666633660894 + 30 2A 80 + 31 0032 2F 00 00 00 00 00 DB 02FH,000H,000H,000H,000H,000H,000H,082H ;+2.00000000000000261007 + 32 00 82 + 33 + 34 003A CONST ENDS + 35 + 36 + 37 DC GROUP DATA,CONST + 38 + 39 + 40 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 41 + 42 PUBLIC $LOD,$DLOG + 43 + 44 EXTRN $DMUL:NEAR, $DPOLYX:NEAR, $DADD:NEAR, $DSUB:NEAR, $DDIV:NEAR + 45 EXTRN $SAVREG:NEAR, $ERC_FC:NEAR, $CIDA:FAR + 46 + 47 ASSUME CS:CODE, DS:DC, ES:DC + 48 + 49 + 50 ;*** $LOG - LOG (base e) function + 51 ; + 52 ; Inputs: + 53 ; BX = Address of operand + 54 ; Outputs: + + +DLOG - Double precision natural logarithm Macro-86 %1(12) 0:59:27 13-Nov-81 Page 1-2 + + + + 55 ; Result in FAC + 56 ; Registers: + 57 ; Only F affected. + 58 + 59 0000 $LOD: + 60 0000 E8 0000 E CALL $SAVREG + 61 0003 $DLOG: + 62 0003 8B F3 MOV SI,BX + 63 0005 BF 0000 E MOV DI,OFFSET DC:$DAC + 64 0008 A5 MOVSW ;Put operand in FAC + 65 0009 A5 MOVSW + 66 000A A5 MOVSW + 67 000B AD LODSW + 68 000C AB STOSW + 69 000D 0A E4 OR AH,AH ;Taking log of zero? + 70 000F 74 62 JZ ARGERR + 71 0011 0A C0 OR AL,AL ;Log of negative number? + 72 0013 78 5E JS ARGERR + 73 0015 C6 06 0000 E 81 MOV [$FAC],81H ;Assign true exponent of 1 + 74 001A 8A C4 MOV AL,AH ;Convert exponent to 16-bit integer + 75 001C 2C 80 SUB AL,80H ; Remove bias + 76 001E 98 CBW + 77 001F 50 PUSH AX + 78 0020 BE 0000 E MOV SI,OFFSET DC:$DAC + 79 0023 BF 0000 E MOV DI,OFFSET DC:$DHALFSQR2 + 80 0026 E8 0000 E CALL $DMUL ;X now in [1/SQRT(2),SQRT2) + 81 0029 BE 0000 E MOV SI,OFFSET DC:$DAC + 82 002C BF 0000 E MOV DI,OFFSET DC:$DBLONE + 83 002F E8 0000 E CALL $DADD + 84 0032 BE 0000 E MOV SI,OFFSET DC:$DBLONE + 85 0035 BF 0000 E MOV DI,OFFSET DC:$DAC + 86 0038 E8 0000 E CALL $DDIV ;DAC = 1 / (Y+1) + 87 003B FE 06 0000 E INC [$FAC] ;DAC = 2 / (Y+1) + 88 003F BE 0000 E MOV SI,OFFSET DC:$DBLONE + 89 0042 BF 0000 E MOV DI,OFFSET DC:$DAC + 90 0045 E8 0000 E CALL $DSUB ;DAC = 1-[2/(Y+1)] = (Y-1)/(Y+1) + 91 0048 BB 0000 R MOV BX,OFFSET DC:LOGTAB + 92 004B E8 0000 E CALL $DPOLYX + 93 004E BE 0000 E MOV SI,OFFSET DC:$DAC + 94 0051 BF 0000 E MOV DI,OFFSET DC:$ARG + 95 0054 A5 MOVSW ;Copy partial result to ARG + 96 0055 A5 MOVSW + 97 0056 A5 MOVSW + 98 0057 A5 MOVSW + 99 0058 5B POP BX ;Recover exponent (as integer) + 100 0059 D1 E3 SHL BX,1 ;Count by halves + 101 005B 4B DEC BX ;Take out 1/2 because of SQRT(2) factor + 102 005C 9A 0000 ---- E CALL $CIDA ;Convert it to D.P. + 103 0061 BE 0000 E MOV SI,OFFSET DC:$DAC + 104 0064 BF 0000 E MOV DI,OFFSET DC:$DHALFLN2 + 105 0067 E8 0000 E CALL $DMUL ;Convert our LOG2 to LOGe + 106 006A BE 0000 E MOV SI,OFFSET DC:$DAC + 107 006D BF 0000 E MOV DI,OFFSET DC:$ARG + 108 0070 E9 0000 E JMP $DADD + + +DLOG - Double precision natural logarithm Macro-86 %1(12) 0:59:27 13-Nov-81 Page 1-3 + + + + 109 + 110 0073 E9 0000 E ARGERR: JMP $ERC_FC + 111 + 112 0076 CODE ENDS + 113 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DLOG - Double precision natural logarithm Macro-86 %1(12) 0:59:27 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0076 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 003A WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 0073 CODE +LOGTAB . . . . . . . . . . . . . L WORD 0000 CONST +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$CIDA. . . . . . . . . . . . . . L FAR 0000 CODE External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DBLONE. . . . . . . . . . . . . V WORD 0000 CONST External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DHALFLN2. . . . . . . . . . . . V WORD 0000 CONST External +$DHALFSQR2 . . . . . . . . . . . V WORD 0000 CONST External +$DLOG. . . . . . . . . . . . . . L NEAR 0003 CODE Global +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DPOLYX. . . . . . . . . . . . . L NEAR 0000 CODE External +$DSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$LOD . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/DLOG.ASM b/3_source_code/BASLIB-86/DLOG.ASM new file mode 100644 index 0000000..2636c39 --- /dev/null +++ b/3_source_code/BASLIB-86/DLOG.ASM @@ -0,0 +1,106 @@ + TITLE DLOG - Double precision natural logarithm + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $DAC:WORD, $FAC:BYTE, $ARG:WORD + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $DBLONE:WORD, $DHALFLN2:WORD, $DHALFSQR2:WORD + +;Coefficient tables for Hart's 2665. Absolute error 16.52, +;range [1/SQRT(2),SQRT(2)]. LOG(x) = zP(z^2), z=(x-1)/(x+1) +; These constants have been checked with MuMath + +LOGTAB DW 6 ;Degree 6 polynomial + DB 0F8H,0F9H,076H,0DEH,0B8H,08CH,02DH,07EH ;+0.16948212488 + DB 04DH,09EH,0CEH,0BFH,0D9H,075H,039H,07EH ;+0.1811136267967 + DB 035H,0BBH,041H,060H,06BH,092H,063H,07EH ;+0.22223823332791 + DB 032H,066H,0C6H,00EH,01EH,049H,012H,07FH ;+0.2857140915904889 + DB 0FBH,0EBH,028H,0D7H,0CCH,0CCH,04CH,07FH ;+0.400000001206045365 + DB 0A3H,009H,0A7H,0AAH,0AAH,0AAH,02AH,080H ;+0.6666666666633660894 + DB 02FH,000H,000H,000H,000H,000H,000H,082H ;+2.00000000000000261007 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $LOD,$DLOG + + EXTRN $DMUL:NEAR, $DPOLYX:NEAR, $DADD:NEAR, $DSUB:NEAR, $DDIV:NEAR + EXTRN $SAVREG:NEAR, $ERC_FC:NEAR, $CIDA:FAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $LOG - LOG (base e) function +; +; Inputs: +; BX = Address of operand +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$LOD: + CALL $SAVREG +$DLOG: + MOV SI,BX + MOV DI,OFFSET DC:$DAC + MOVSW ;Put operand in FAC + MOVSW + MOVSW + LODSW + STOSW + OR AH,AH ;Taking log of zero? + JZ ARGERR + OR AL,AL ;Log of negative number? + JS ARGERR + MOV [$FAC],81H ;Assign true exponent of 1 + MOV AL,AH ;Convert exponent to 16-bit integer + SUB AL,80H ; Remove bias + CBW + PUSH AX + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$DHALFSQR2 + CALL $DMUL ;X now in [1/SQRT(2),SQRT2) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$DBLONE + CALL $DADD + MOV SI,OFFSET DC:$DBLONE + MOV DI,OFFSET DC:$DAC + CALL $DDIV ;DAC = 1 / (Y+1) + INC [$FAC] ;DAC = 2 / (Y+1) + MOV SI,OFFSET DC:$DBLONE + MOV DI,OFFSET DC:$DAC + CALL $DSUB ;DAC = 1-[2/(Y+1)] = (Y-1)/(Y+1) + MOV BX,OFFSET DC:LOGTAB + CALL $DPOLYX + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG + MOVSW ;Copy partial result to ARG + MOVSW + MOVSW + MOVSW + POP BX ;Recover exponent (as integer) + SHL BX,1 ;Count by halves + DEC BX ;Take out 1/2 because of SQRT(2) factor + CALL $CIDA ;Convert it to D.P. + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$DHALFLN2 + CALL $DMUL ;Convert our LOG2 to LOGe + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG + JMP $DADD + +ARGERR: JMP $ERC_FC + +CODE ENDS + END From 435f30778a83426c773bc4fc5825ea5b554ebb3d Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 19 Jun 2026 14:32:02 -0700 Subject: [PATCH 10/53] Transcription of Bundle 9 - INVOLD.ASM Code and Listing --- 2_printed_files/bundle_09/INVOLD.ASM | 300 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/INVOLD.ASM | 211 +++++++++++++++++++ 2 files changed, 511 insertions(+) create mode 100644 2_printed_files/bundle_09/INVOLD.ASM create mode 100644 3_source_code/BASLIB-86/INVOLD.ASM diff --git a/2_printed_files/bundle_09/INVOLD.ASM b/2_printed_files/bundle_09/INVOLD.ASM new file mode 100644 index 0000000..2ce334d --- /dev/null +++ b/2_printed_files/bundle_09/INVOLD.ASM @@ -0,0 +1,300 @@ +INVOLD - Double precision involution operator Macro-86 %1(12) 0:59:33 13-Nov-81 Page 1-1 + + + + 1 TITLE INVOLD - Double precision involution operator + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $DAC:WORD, $ARG:WORD, $FAC:BYTE, $TEMP:WORD, $TEMP2:WORD + 6 + 7 0000 ???? POWERCNT DW ? + 8 0002 ?? FLAG DB ? + 9 + 10 0003 DATA ENDS + 11 + 12 + 13 DC GROUP DATA + 14 + 15 + 16 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 17 + 18 PUBLIC $FEXB, $FEXD, $FEXF, $FEXH + 19 + 20 EXTRN $SAVREG:NEAR, $DMUL:NEAR, $GTMP:NEAR, $LOD:FAR, $DEXP:NEAR + 21 EXTRN $DDIV:NEAR, $DSUB:NEAR, $FID:FAR, $DIV0:NEAR, $ERC_FC:NEAR + 22 EXTRN $PUT1D:NEAR + 23 + 24 ASSUME CS:CODE, DS:DC, ES:DC + 25 + 26 ; Suffix B means address of operands in SI and DI + 27 ; Suffix D means first operand is FAC, second is at [DI] (SI smashed) + 28 ; Suffix F means first operand is at [SI], second is FAC (DI smashed) + 29 ; Suffix H means first operand is floating temp, second is FAC (SI and DI hit) + 30 + 31 0000 $FEXD: + 32 0000 BE 0000 E MOV SI,OFFSET DC:$DAC + 33 0003 EB 06 JMP SHORT $FEXB + 34 0005 $FEXH: + 35 0005 E8 0000 E CALL $GTMP + 36 0008 $FEXF: + 37 0008 BF 0000 E MOV DI,OFFSET DC:$DAC + 38 000B $FEXB: + 39 000B E8 0000 E CALL $SAVREG + 40 000E 33 C0 XOR AX,AX + 41 0010 A2 0002 R MOV [FLAG],AL ;Set sign positive, no mul or div needed yet + 42 0013 A3 0000 R MOV [POWERCNT],AX + 43 0016 8B 45 06 MOV AX,[DI+6] ;Get sign and exponent of Y + 44 0019 0A E4 OR AH,AH ;Is Y zero? + 45 001B 74 5A JZ ONE + 46 001D 8B 54 06 MOV DX,[SI+6] + 47 0020 0A F6 OR DH,DH ;Is X zero? + 48 0022 74 56 JZ ZERCHK + 49 0024 8B DF MOV BX,DI ;Save address of Y + 50 0026 BF 0000 E MOV DI,OFFSET DC:$TEMP2 + 51 0029 A5 MOVSW ;Save X in TEMP2 + 52 002A A5 MOVSW + 53 002B A5 MOVSW + 54 002C A5 MOVSW + + +INVOLD - Double precision involution operator Macro-86 %1(12) 0:59:33 13-Nov-81 Page 1-2 + + + + 55 002D 8B F3 MOV SI,BX + 56 002F BF 0000 E MOV DI,OFFSET DC:$TEMP + 57 0032 A5 MOVSW ;Move Y to TEMP + 58 0033 A5 MOVSW + 59 0034 A5 MOVSW + 60 0035 AB STOSW ;AX already has high word + 61 0036 9A 0000 ---- E CALL $FID ;FAC = INT(Y) + 62 ;DAC has INT(Y), TEMP has Y, TEMP2 has X + 63 003B 80 FC 90 CMP AH,80H+16 ;ABS(Y) >= 2^16? + 64 003E 76 4A JBE SMALLPOWER + 65 ;At this point we have a power larger than 2^16. This is so large that + 66 ;instead of doing repeat multiplies we will just use EXP(Y*LOG(X)) + 67 0040 0A D2 OR DL,DL ;X < 0? + 68 0042 79 31 JNS LOGPOWERJ + 69 ;Using LOG and EXP is fine if the base is positive. We're here because the + 70 ;the base is negative (which won't wash with LOG). Involution is defined + 71 ;for negative base only if the power is integer. Then, if the integer is + 72 ;odd, the result is -[abs(x)^y]; if even, it's abs(x)^y. If the number is + 73 ;too large to include a 2^0 bit in its 56-bit mantissa, then we can't + 74 ;determine even or odd and call this an error. + 75 0044 80 FC B8 CMP AH,80H+56 ;ABS(Y) >= 2^56? + 76 0047 77 3E JA ARGERR ;If so, can't tell if odd - error! + 77 0049 BE 0000 E MOV SI,OFFSET DC:$TEMP + 78 004C BF 0000 E MOV DI,OFFSET DC:$DAC + 79 004F B9 0003 MOV CX,3 + 80 0052 F3/ A7 REPE CMPSW ;Compare Y, INT(Y) to see if Y is integer + 81 0054 75 31 JNZ ARGERR + 82 ;It's going to work, now we just need that 2^0 bit for even/odd determination + 83 0056 80 EC 81 SUB AH,80H+1 ;Get shift count range 16-55 + 84 0059 8A CC MOV CL,AH + 85 005B 80 E1 07 AND CL,7 ;Get bit within byte + 86 005E 8A C4 MOV AL,AH + 87 0060 D0 E8 SHR AL,1 + 88 0062 D0 E8 SHR AL,1 + 89 0064 D0 E8 SHR AL,1 + 90 0066 98 CBW + 91 0067 2B F8 SUB DI,AX ;Points to byte with even/odd bit + 92 0069 8A 05 MOV AL,[DI] + 93 006B D2 E0 SHL AL,CL ;LSB of Y in bit 7, to tell us even or odd + 94 006D A2 0002 R MOV [FLAG],AL ;Use it as sign of result + 95 0070 80 26 0006 E 7F AND BYTE PTR [$TEMP2+6],7FH ;Make X positive + 96 0075 LOGPOWERJ: + 97 0075 EB 45 JMP SHORT LOGPOWER + 98 + 99 0077 E9 0000 E ONE: JMP $PUT1D + 100 + 101 007A ZERCHK: + 102 007A C6 06 0000 E 00 MOV [$FAC],0 ;Put a zero in FAC + 103 007F 0A C0 OR AL,AL ;Is power negative? + 104 0081 79 03 JNS RET + 105 0083 E9 0000 E JMP $DIV0 ;If so, that's 1/0 - divide zero error + 106 0086 C3 RET: RET + 107 + 108 0087 E9 0000 E ARGERR: JMP $ERC_FC ;Illegal function call + + +INVOLD - Double precision involution operator Macro-86 %1(12) 0:59:33 13-Nov-81 Page 1-3 + + + + 109 + 110 008A SMALLPOWER: + 111 008A 80 FC 80 CMP AH,80H ;Y < 1? + 112 008D 76 1A JBE ZEROPWR + 113 008F B1 90 MOV CL,80H+16 + 114 0091 2A CC SUB CL,AH ;Shift count to make Y integer + 115 0093 8A F8 MOV BH,AL + 116 0095 8A DD MOV BL,CH ;Mantissa of Y in BX + 117 0097 80 CF 80 OR BH,80H ;Set implied bit + 118 009A D3 EB SHR BX,CL ;BX = Y as integer + 119 009C 89 1E 0000 R MOV [POWERCNT],BX + 120 00A0 0A C0 OR AL,AL ;Y < 0? + 121 00A2 79 05 JNS ZEROPWR + 122 00A4 80 0E 0002 R 02 OR [FLAG],2 ;Since power is negative, we'll need to invert + 123 00A9 ZEROPWR: + 124 00A9 BE 0000 E MOV SI,OFFSET DC:$TEMP + 125 00AC BF 0000 E MOV DI,OFFSET DC:$DAC + 126 00AF E8 0000 E CALL $DSUB ;FAC = Y - INT(Y) + 127 00B2 BE 0000 E MOV SI,OFFSET DC:$DAC + 128 00B5 BF 0000 E MOV DI,OFFSET DC:$TEMP + 129 00B8 A5 MOVSW ;Move result back to TEMP + 130 00B9 A5 MOVSW + 131 00BA A5 MOVSW + 132 00BB A5 MOVSW + 133 00BC LOGPOWER: + 134 ;TEMP has FRAC(Y), TEMP2 has X + 135 00BC 80 3E 0007 E 00 CMP BYTE PTR [$TEMP+7],0 ;Is fraction part zero? + 136 00C1 74 1E JZ MULPOWER + 137 00C3 BB 0000 E MOV BX,OFFSET DC:$TEMP2 + 138 00C6 9A 0000 ---- E CALL $LOD ;Take log base e of X + 139 00CB BE 0000 E MOV SI,OFFSET DC:$DAC + 140 00CE BF 0000 E MOV DI,OFFSET DC:$TEMP + 141 00D1 E8 0000 E CALL $DMUL ;FAC = Y * LN(X) + 142 00D4 BB 0000 E MOV BX,OFFSET DC:$DAC + 143 00D7 E8 0000 E CALL $DEXP ;FAC = e^(Y*LN(X)) + 144 00DA 80 0E 0002 R 01 OR [FLAG],1 ;Multiplication by integer part will be needed + 145 00DF EB 03 JMP SHORT MULCHK + 146 + 147 00E1 MULPOWER: + 148 00E1 E8 0000 E CALL $PUT1D ;Put a one in FAC as result of fraction part + 149 00E4 MULCHK: + 150 00E4 8B 0E 0000 R MOV CX,[POWERCNT] + 151 00E8 E3 26 JCXZ SETSIGN + 152 00EA BE 0000 E MOV SI,OFFSET DC:$DAC + 153 00ED BF 0000 E MOV DI,OFFSET DC:$TEMP + 154 00F0 A5 MOVSW ;Copy result of fraction part to TEMP + 155 00F1 A5 MOVSW + 156 00F2 A5 MOVSW + 157 00F3 A5 MOVSW + 158 00F4 E8 011A R CALL XTON ;Raise TEMP2 to CX power + 159 00F7 A0 0002 R MOV AL,[FLAG] + 160 00FA A8 03 TEST AL,3 ;Need to multiply or divide? + 161 00FC 74 12 JZ SETSIGN + 162 00FE BF 0000 E MOV DI,OFFSET DC:$DAC + + +INVOLD - Double precision involution operator Macro-86 %1(12) 0:59:33 13-Nov-81 Page 1-4 + + + + 163 0101 BE 0000 E MOV SI,OFFSET DC:$TEMP + 164 0104 A8 02 TEST AL,2 ;Need to divide? + 165 0106 75 05 JNZ POSTDIV + 166 0108 E8 0000 E CALL $DMUL + 167 010B EB 03 JMP SHORT SETSIGN + 168 + 169 010D POSTDIV: + 170 010D E8 0000 E CALL $DDIV + 171 0110 SETSIGN: + 172 0110 A0 0002 R MOV AL,[FLAG] + 173 0113 24 80 AND AL,80H ;Mask to sign bit + 174 0115 08 06 FFFF E OR [$FAC-1],AL ;Set sign of result + 175 0119 C3 DONE: RET + 176 + 177 011A XTON: ;Raise $TEMP2 to CX power by repeat multiplication + 178 011A E8 0000 E CALL $PUT1D ;Put 1 in FAC + 179 011D INTPWR: + 180 011D D1 E9 SHR CX,1 ;Need to multiply by this power? + 181 011F 73 0B JNC SQUARE + 182 0121 51 PUSH CX + 183 0122 BE 0000 E MOV SI,OFFSET DC:$TEMP2 + 184 0125 BF 0000 E MOV DI,OFFSET DC:$DAC + 185 0128 E8 0000 E CALL $DMUL + 186 012B 59 POP CX + 187 012C SQUARE: + 188 012C E3 EB JCXZ DONE + 189 012E 51 PUSH CX + 190 012F FF 36 0000 E PUSH [$DAC] + 191 0133 FF 36 0002 E PUSH [$DAC+2] + 192 0137 FF 36 0004 E PUSH [$DAC+4] + 193 013B FF 36 0006 E PUSH [$DAC+6] + 194 013F BE 0000 E MOV SI,OFFSET DC:$TEMP2 + 195 0142 8B FE MOV DI,SI + 196 0144 E8 0000 E CALL $DMUL ;Square argument + 197 0147 BE 0000 E MOV SI,OFFSET DC:$DAC + 198 014A BF 0000 E MOV DI,OFFSET DC:$TEMP2 + 199 014D A5 MOVSW + 200 014E A5 MOVSW + 201 014F A5 MOVSW + 202 0150 A5 MOVSW ;And move it back to TEMP2 + 203 0151 8F 06 0006 E POP [$DAC+6] + 204 0155 8F 06 0004 E POP [$DAC+4] + 205 0159 8F 06 0002 E POP [$DAC+2] + 206 015D 8F 06 0000 E POP [$DAC] ;Restore power being built in FAC + 207 0161 59 POP CX + 208 0162 EB B9 JMP INTPWR + 209 + 210 0164 CODE ENDS + 211 END + + + + + + + +INVOLD - Double precision involution operator Macro-86 %1(12) 0:59:33 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0164 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0003 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 0087 CODE +DONE . . . . . . . . . . . . . . L NEAR 0119 CODE +FLAG . . . . . . . . . . . . . . L BYTE 0002 DATA +INTPWR . . . . . . . . . . . . . L NEAR 011D CODE +LOGPOWER . . . . . . . . . . . . L NEAR 00BC CODE +LOGPOWERJ. . . . . . . . . . . . L NEAR 0075 CODE +MULCHK . . . . . . . . . . . . . L NEAR 00E4 CODE +MULPOWER . . . . . . . . . . . . L NEAR 00E1 CODE +ONE. . . . . . . . . . . . . . . L NEAR 0077 CODE +POSTDIV. . . . . . . . . . . . . L NEAR 010D CODE +POWERCNT . . . . . . . . . . . . L WORD 0000 DATA +RET. . . . . . . . . . . . . . . L NEAR 0086 CODE +SETSIGN. . . . . . . . . . . . . L NEAR 0110 CODE +SMALLPOWER . . . . . . . . . . . L NEAR 008A CODE +SQUARE . . . . . . . . . . . . . L NEAR 012C CODE +XTON . . . . . . . . . . . . . . L NEAR 011A CODE +ZERCHK . . . . . . . . . . . . . L NEAR 007A CODE +ZEROPWR. . . . . . . . . . . . . L NEAR 00A9 CODE +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DEXP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DIV0. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FEXB. . . . . . . . . . . . . . L NEAR 000B CODE Global +$FEXD. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FEXF. . . . . . . . . . . . . . L NEAR 0008 CODE Global +$FEXH. . . . . . . . . . . . . . L NEAR 0005 CODE Global +$FID . . . . . . . . . . . . . . L FAR 0000 CODE External +$GTMP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$LOD . . . . . . . . . . . . . . L FAR 0000 CODE External +$PUT1D . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External +$TEMP2 . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + diff --git a/3_source_code/BASLIB-86/INVOLD.ASM b/3_source_code/BASLIB-86/INVOLD.ASM new file mode 100644 index 0000000..871cddd --- /dev/null +++ b/3_source_code/BASLIB-86/INVOLD.ASM @@ -0,0 +1,211 @@ + TITLE INVOLD - Double precision involution operator + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $DAC:WORD, $ARG:WORD, $FAC:BYTE, $TEMP:WORD, $TEMP2:WORD + +POWERCNT DW ? +FLAG DB ? + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FEXB, $FEXD, $FEXF, $FEXH + + EXTRN $SAVREG:NEAR, $DMUL:NEAR, $GTMP:NEAR, $LOD:FAR, $DEXP:NEAR + EXTRN $DDIV:NEAR, $DSUB:NEAR, $FID:FAR, $DIV0:NEAR, $ERC_FC:NEAR + EXTRN $PUT1D:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +; Suffix B means address of operands in SI and DI +; Suffix D means first operand is FAC, second is at [DI] (SI smashed) +; Suffix F means first operand is at [SI], second is FAC (DI smashed) +; Suffix H means first operand is floating temp, second is FAC (SI and DI hit) + +$FEXD: + MOV SI,OFFSET DC:$DAC + JMP SHORT $FEXB +$FEXH: + CALL $GTMP +$FEXF: + MOV DI,OFFSET DC:$DAC +$FEXB: + CALL $SAVREG + XOR AX,AX + MOV [FLAG],AL ;Set sign positive, no mul or div needed yet + MOV [POWERCNT],AX + MOV AX,[DI+6] ;Get sign and exponent of Y + OR AH,AH ;Is Y zero? + JZ ONE + MOV DX,[SI+6] + OR DH,DH ;Is X zero? + JZ ZERCHK + MOV BX,DI ;Save address of Y + MOV DI,OFFSET DC:$TEMP2 + MOVSW ;Save X in TEMP2 + MOVSW + MOVSW + MOVSW + MOV SI,BX + MOV DI,OFFSET DC:$TEMP + MOVSW ;Move Y to TEMP + MOVSW + MOVSW + STOSW ;AX already has high word + CALL $FID ;FAC = INT(Y) +;DAC has INT(Y), TEMP has Y, TEMP2 has X + CMP AH,80H+16 ;ABS(Y) >= 2^16? + JBE SMALLPOWER +;At this point we have a power larger than 2^16. This is so large that +;instead of doing repeat multiplies we will just use EXP(Y*LOG(X)) + OR DL,DL ;X < 0? + JNS LOGPOWERJ +;Using LOG and EXP is fine if the base is positive. We're here because the +;the base is negative (which won't wash with LOG). Involution is defined +;for negative base only if the power is integer. Then, if the integer is +;odd, the result is -[abs(x)^y]; if even, it's abs(x)^y. If the number is +;too large to include a 2^0 bit in its 56-bit mantissa, then we can't +;determine even or odd and call this an error. + CMP AH,80H+56 ;ABS(Y) >= 2^56? + JA ARGERR ;If so, can't tell if odd - error! + MOV SI,OFFSET DC:$TEMP + MOV DI,OFFSET DC:$DAC + MOV CX,3 + REPE CMPSW ;Compare Y, INT(Y) to see if Y is integer + JNZ ARGERR +;It's going to work, now we just need that 2^0 bit for even/odd determination + SUB AH,80H+1 ;Get shift count range 16-55 + MOV CL,AH + AND CL,7 ;Get bit within byte + MOV AL,AH + SHR AL,1 + SHR AL,1 + SHR AL,1 + CBW + SUB DI,AX ;Points to byte with even/odd bit + MOV AL,[DI] + SHL AL,CL ;LSB of Y in bit 7, to tell us even or odd + MOV [FLAG],AL ;Use it as sign of result + AND BYTE PTR [$TEMP2+6],7FH ;Make X positive +LOGPOWERJ: + JMP SHORT LOGPOWER + +ONE: JMP $PUT1D + +ZERCHK: + MOV [$FAC],0 ;Put a zero in FAC + OR AL,AL ;Is power negative? + JNS RET + JMP $DIV0 ;If so, that's 1/0 - divide zero error +RET: RET + +ARGERR: JMP $ERC_FC ;Illegal function call + +SMALLPOWER: + CMP AH,80H ;Y < 1? + JBE ZEROPWR + MOV CL,80H+16 + SUB CL,AH ;Shift count to make Y integer + MOV BH,AL + MOV BL,CH ;Mantissa of Y in BX + OR BH,80H ;Set implied bit + SHR BX,CL ;BX = Y as integer + MOV [POWERCNT],BX + OR AL,AL ;Y < 0? + JNS ZEROPWR + OR [FLAG],2 ;Since power is negative, we'll need to invert +ZEROPWR: + MOV SI,OFFSET DC:$TEMP + MOV DI,OFFSET DC:$DAC + CALL $DSUB ;FAC = Y - INT(Y) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + MOVSW ;Move result back to TEMP + MOVSW + MOVSW + MOVSW +LOGPOWER: +;TEMP has FRAC(Y), TEMP2 has X + CMP BYTE PTR [$TEMP+7],0 ;Is fraction part zero? + JZ MULPOWER + MOV BX,OFFSET DC:$TEMP2 + CALL $LOD ;Take log base e of X + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + CALL $DMUL ;FAC = Y * LN(X) + MOV BX,OFFSET DC:$DAC + CALL $DEXP ;FAC = e^(Y*LN(X)) + OR [FLAG],1 ;Multiplication by integer part will be needed + JMP SHORT MULCHK + +MULPOWER: + CALL $PUT1D ;Put a one in FAC as result of fraction part +MULCHK: + MOV CX,[POWERCNT] + JCXZ SETSIGN + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + MOVSW ;Copy result of fraction part to TEMP + MOVSW + MOVSW + MOVSW + CALL XTON ;Raise TEMP2 to CX power + MOV AL,[FLAG] + TEST AL,3 ;Need to multiply or divide? + JZ SETSIGN + MOV DI,OFFSET DC:$DAC + MOV SI,OFFSET DC:$TEMP + TEST AL,2 ;Need to divide? + JNZ POSTDIV + CALL $DMUL + JMP SHORT SETSIGN + +POSTDIV: + CALL $DDIV +SETSIGN: + MOV AL,[FLAG] + AND AL,80H ;Mask to sign bit + OR [$FAC-1],AL ;Set sign of result +DONE: RET + +XTON: ;Raise $TEMP2 to CX power by repeat multiplication + CALL $PUT1D ;Put 1 in FAC +INTPWR: + SHR CX,1 ;Need to multiply by this power? + JNC SQUARE + PUSH CX + MOV SI,OFFSET DC:$TEMP2 + MOV DI,OFFSET DC:$DAC + CALL $DMUL + POP CX +SQUARE: + JCXZ DONE + PUSH CX + PUSH [$DAC] + PUSH [$DAC+2] + PUSH [$DAC+4] + PUSH [$DAC+6] + MOV SI,OFFSET DC:$TEMP2 + MOV DI,SI + CALL $DMUL ;Square argument + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP2 + MOVSW + MOVSW + MOVSW + MOVSW ;And move it back to TEMP2 + POP [$DAC+6] + POP [$DAC+4] + POP [$DAC+2] + POP [$DAC] ;Restore power being built in FAC + POP CX + JMP INTPWR + +CODE ENDS + END From 3141d4fa0245d61b872f1ddbc10fc78e930f9213 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 20 Jun 2026 13:14:26 -0700 Subject: [PATCH 11/53] Transcription of Bundle 9 - DSIN.ASM Code and Listing --- 2_printed_files/bundle_09/DSIN.ASM | 240 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DSIN.ASM | 152 ++++++++++++++++++ 2 files changed, 392 insertions(+) create mode 100644 2_printed_files/bundle_09/DSIN.ASM create mode 100644 3_source_code/BASLIB-86/DSIN.ASM diff --git a/2_printed_files/bundle_09/DSIN.ASM b/2_printed_files/bundle_09/DSIN.ASM new file mode 100644 index 0000000..5f2835b --- /dev/null +++ b/2_printed_files/bundle_09/DSIN.ASM @@ -0,0 +1,240 @@ +DSIN - Double precision sine and cosine functions Macro-86 %1(12) 0:59:42 13-Nov-81 Page 1-1 + + + + 1 TITLE DSIN - Double precision sine and cosine functions + 2 + 3 0000 DATA SEGMENT BYTE PUBLIC 'DATA' + 4 + 5 EXTRN $DAC:WORD, $ARG:WORD, $FAC:BYTE, $TEMP:WORD + 6 + 7 0000 ?? SIGN DB ? + 8 + 9 0001 DATA ENDS + 10 + 11 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 12 + 13 EXTRN $DBLHALF:WORD,$DBLONE:WORD,$DRECIP2PI:WORD,$DBL4TH:WORD + 14 + 15 ;Coefficients for Hart's #3345, relative precision 18.59 + 16 ; Hart's coefficients are intended to compute SIN(x*PI/2) = xP(x^2) + 17 ; with x in range [0,1] (or [-1,1]). Instead, we compute + 18 ; SIN(x*2*PI) = xP(x^2), x in [-1/4,1/4]. Thus our x is 1/4 the + 19 ; the size intended, so each coefficient is multiplied by the + 20 ; needed power of 4 to correct for this. + 21 ; These constants have been checked with MuMath + 22 + 23 0000 0008 SINTAB DW 8 ;8th degree + 24 ;+0.00000000000587061098171 * 4^17 + 25 0002 F2 CC BF 4A C3 8D DB 0F2H,0CCH,0BFH,04AH,0C3H,08DH,04EH,07DH + 26 4E 7D + 27 + 28 ;-0.00000000066843217206396 * 4^15 + 29 000A 6B A6 2C 86 BB BC DB 06BH,0A6H,02CH,086H,0BBH,0BCH,0B7H,080H + 30 B7 80 + 31 + 32 ;+0.00000005692134872719023 * 4^13 + 33 0012 E2 D9 AC 4E AF 79 DB 0E2H,0D9H,0ACH,04EH,0AFH,079H,074H,082H + 34 74 82 + 35 + 36 ;-0.00000359884300720869272 * 4^11 + 37 001A 0E B8 8E EE A6 83 DB 00EH,0B8H,08EH,0EEH,0A6H,083H,0F1H,084H + 38 F1 84 + 39 + 40 ;+0.0001604411847068220716 * 4^9 + 41 0022 5A 86 8C 42 1A 3C DB 05AH,086H,08CH,042H,01AH,03CH,028H,086H + 42 28 86 + 43 + 44 ;-0.00468175413530264260121 * 4^7 + 45 002A 14 AA 13 73 66 69 DB 014H,0AAH,013H,073H,066H,069H,099H,087H + 46 99 87 + 47 + 48 ;+0.07969262624616543562977 * 4^5 + 49 0032 6F 53 AD 3B E3 35 DB 06FH,053H,0ADH,03BH,0E3H,035H,023H,087H + 50 23 87 + 51 + 52 ;-0.64596409750624619108547 * 4^3 + 53 003A 91 F2 2D 31 E7 5D DB 091H,0F2H,02DH,031H,0E7H,05DH,0A5H,086H + 54 A5 86 + + +DSIN - Double precision sine and cosine functions Macro-86 %1(12) 0:59:42 13-Nov-81 Page 1-2 + + + + 55 + 56 ;+1.5707963267948966188272 * 4^1 + 57 0042 C2 68 21 A2 DA 0F DB 0C2H,068H,021H,0A2H,0DAH,00FH,049H,083H + 58 49 83 + 59 + 60 004A CONST ENDS + 61 + 62 + 63 DC GROUP CONST,DATA + 64 + 65 + 66 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 67 + 68 PUBLIC $SID, $COD, $TAD + 69 + 70 EXTRN $SAVREG:NEAR, $FID:FAR, $DPOLYX:NEAR + 71 EXTRN $DSUB:NEAR, $DDIV:NEAR, $DMUL:NEAR + 72 + 73 ASSUME CS:CODE, DS:DC, ES:DC + 74 + 75 + 76 ;*** $SID, $COD - Sine and Cosine trig functions + 77 ; + 78 ; Inputs: + 79 ; BX = Address of argument + 80 ; Outputs: + 81 ; Result in FAC + 82 ; Registers: + 83 ; No registers affected. + 84 + 85 0000 $TAD: + 86 0000 E8 0000 E CALL $SAVREG + 87 0003 FF 37 PUSH [BX] ;Save value of argument + 88 0005 FF 77 02 PUSH [BX+2] + 89 0008 FF 77 04 PUSH [BX+4] + 90 000B FF 77 06 PUSH [BX+6] + 91 000E E8 0058 R CALL SINF ;Compute sin(x) + 92 0011 BE 0000 E MOV SI,OFFSET DC:$DAC + 93 0014 BF 0000 E MOV DI,OFFSET DC:$TEMP + 94 0017 A5 MOVSW + 95 0018 A5 MOVSW + 96 0019 A5 MOVSW + 97 001A A5 MOVSW + 98 001B 8F 06 0006 E POP [$DAC+6] ;Restore argument to FAC + 99 001F 8F 06 0004 E POP [$DAC+4] + 100 0023 8F 06 0002 E POP [$DAC+2] + 101 0027 8F 06 0000 E POP [$DAC] + 102 002B BE 0000 E MOV SI,OFFSET DC:$DAC + 103 002E E8 003F R CALL COSF ;Compute cos(x) + 104 0031 BE 0000 E MOV SI,OFFSET DC:$TEMP + 105 0034 BF 0000 E MOV DI,OFFSET DC:$DAC + 106 0037 E9 0000 E JMP $DDIV ;Tan = sin/cos + 107 + 108 003A $COD: ;Double precision cosine + + +DSIN - Double precision sine and cosine functions Macro-86 %1(12) 0:59:42 13-Nov-81 Page 1-3 + + + + 109 003A E8 0000 E CALL $SAVREG + 110 003D 8B F3 MOV SI,BX + 111 003F COSF: + 112 003F BF 0000 E MOV DI,OFFSET DC:$DRECIP2PI + 113 0042 E8 0000 E CALL $DMUL + 114 0045 80 26 FFFF E 7F AND [$FAC-1],7FH ;Take absolute value - COS(X) = COS(-X) + 115 004A BF 0000 E MOV DI,OFFSET DC:$DAC + 116 004D BE 0000 E MOV SI,OFFSET DC:$DBL4TH + 117 0050 E8 0000 E CALL $DSUB ;Use COS(X)=SIN(PI/2-X) + 118 0053 EB 0B JMP SHORT SINCOS + 119 + 120 0055 $SID: ;Double precision sine + 121 0055 E8 0000 E CALL $SAVREG + 122 0058 SINF: + 123 0058 8B F3 MOV SI,BX + 124 005A BF 0000 E MOV DI,OFFSET DC:$DRECIP2PI + 125 005D E8 0000 E CALL $DMUL + 126 0060 SINCOS: + 127 0060 A0 FFFF E MOV AL,[$FAC-1] ;Get sign + 128 0063 A2 0000 R MOV [SIGN],AL + 129 0066 24 7F AND AL,7FH ;Take absolute value + 130 0068 A2 FFFF E MOV [$FAC-1],AL + 131 006B BE 0000 E MOV SI,OFFSET DC:$DAC + 132 006E BF 0000 E MOV DI,OFFSET DC:$ARG + 133 0071 A5 MOVSW ;Save X so far + 134 0072 A5 MOVSW + 135 0073 A5 MOVSW + 136 0074 A5 MOVSW + 137 0075 BB 0000 E MOV BX,OFFSET DC:$DAC + 138 0078 9A 0000 ---- E CALL $FID ;FAC=INT(X), X >= 0 + 139 007D BE 0000 E MOV SI,OFFSET DC:$ARG + 140 0080 BF 0000 E MOV DI,OFFSET DC:$DAC + 141 0083 E8 0000 E CALL $DSUB ;FAC= X - INT(X) (always positive or zero) + 142 0086 80 3E 0000 E 7F CMP [$FAC],7FH ;Is X < 1/4? (In first quadrant?) + 143 008B 72 16 JB FIGSIN ;If so, go compute + 144 008D 81 3E 0006 E 8040 CMP [$DAC+6],8040H ;Is X > = 3/4? (In fourth quadrant?) + 145 0093 BE 0000 E MOV SI,OFFSET DC:$DBLHALF + 146 0096 BF 0000 E MOV DI,OFFSET DC:$DAC ;Subtract from 1/2 if in II or III + 147 0099 72 05 JB SUB + 148 009B 8B F7 MOV SI,DI + 149 009D BF 0000 E MOV DI,OFFSET DC:$DBLONE ;Subtract 1 from it if in IV + 150 00A0 SUB: + 151 00A0 E8 0000 E CALL $DSUB + 152 00A3 FIGSIN: + 153 00A3 BB 0000 R MOV BX,OFFSET DC:SINTAB + 154 00A6 E8 0000 E CALL $DPOLYX + 155 00A9 A0 0000 R MOV AL,[SIGN] + 156 00AC 24 80 AND AL,80H ;Reduce to sign bit + 157 00AE 30 06 FFFF E XOR [$FAC-1],AL ;Flip sign if input was negative + 158 00B2 C3 RET + 159 + 160 00B3 CODE ENDS + 161 END + + + +DSIN - Double precision sine and cosine functions Macro-86 %1(12) 0:59:42 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00B3 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 004A WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0001 BYTE PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +COSF . . . . . . . . . . . . . . L NEAR 003F CODE +FIGSIN . . . . . . . . . . . . . L NEAR 00A3 CODE +SIGN . . . . . . . . . . . . . . L BYTE 0000 DATA +SINCOS . . . . . . . . . . . . . L NEAR 0060 CODE +SINF . . . . . . . . . . . . . . L NEAR 0058 CODE +SINTAB . . . . . . . . . . . . . L WORD 0000 CONST +SUB. . . . . . . . . . . . . . . L NEAR 00A0 CODE +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$COD . . . . . . . . . . . . . . L NEAR 003A CODE Global +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DBL4TH. . . . . . . . . . . . . V WORD 0000 CONST External +$DBLHALF . . . . . . . . . . . . V WORD 0000 CONST External +$DBLONE. . . . . . . . . . . . . V WORD 0000 CONST External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DPOLYX. . . . . . . . . . . . . L NEAR 0000 CODE External +$DRECIP2PI . . . . . . . . . . . V WORD 0000 CONST External +$DSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FID . . . . . . . . . . . . . . L FAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SID . . . . . . . . . . . . . . L NEAR 0055 CODE Global +$TAD . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/DSIN.ASM b/3_source_code/BASLIB-86/DSIN.ASM new file mode 100644 index 0000000..fd0f8d1 --- /dev/null +++ b/3_source_code/BASLIB-86/DSIN.ASM @@ -0,0 +1,152 @@ + TITLE DSIN - Double precision sine and cosine functions + +DATA SEGMENT BYTE PUBLIC 'DATA' + + EXTRN $DAC:WORD, $ARG:WORD, $FAC:BYTE, $TEMP:WORD + +SIGN DB ? + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $DBLHALF:WORD,$DBLONE:WORD,$DRECIP2PI:WORD,$DBL4TH:WORD + +;Coefficients for Hart's #3345, relative precision 18.59 +; Hart's coefficients are intended to compute SIN(x*PI/2) = xP(x^2) +; with x in range [0,1] (or [-1,1]). Instead, we compute +; SIN(x*2*PI) = xP(x^2), x in [-1/4,1/4]. Thus our x is 1/4 the +; the size intended, so each coefficient is multiplied by the +; needed power of 4 to correct for this. +; These constants have been checked with MuMath + +SINTAB DW 8 ;8th degree +;+0.00000000000587061098171 * 4^17 + DB 0F2H,0CCH,0BFH,04AH,0C3H,08DH,04EH,07DH + +;-0.00000000066843217206396 * 4^15 + DB 06BH,0A6H,02CH,086H,0BBH,0BCH,0B7H,080H + +;+0.00000005692134872719023 * 4^13 + DB 0E2H,0D9H,0ACH,04EH,0AFH,079H,074H,082H + +;-0.00000359884300720869272 * 4^11 + DB 00EH,0B8H,08EH,0EEH,0A6H,083H,0F1H,084H + +;+0.0001604411847068220716 * 4^9 + DB 05AH,086H,08CH,042H,01AH,03CH,028H,086H + +;-0.00468175413530264260121 * 4^7 + DB 014H,0AAH,013H,073H,066H,069H,099H,087H + +;+0.07969262624616543562977 * 4^5 + DB 06FH,053H,0ADH,03BH,0E3H,035H,023H,087H + +;-0.64596409750624619108547 * 4^3 + DB 091H,0F2H,02DH,031H,0E7H,05DH,0A5H,086H + +;+1.5707963267948966188272 * 4^1 + DB 0C2H,068H,021H,0A2H,0DAH,00FH,049H,083H + +CONST ENDS + + +DC GROUP CONST,DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $SID, $COD, $TAD + + EXTRN $SAVREG:NEAR, $FID:FAR, $DPOLYX:NEAR + EXTRN $DSUB:NEAR, $DDIV:NEAR, $DMUL:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $SID, $COD - Sine and Cosine trig functions +; +; Inputs: +; BX = Address of argument +; Outputs: +; Result in FAC +; Registers: +; No registers affected. + +$TAD: + CALL $SAVREG + PUSH [BX] ;Save value of argument + PUSH [BX+2] + PUSH [BX+4] + PUSH [BX+6] + CALL SINF ;Compute sin(x) + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + MOVSW + MOVSW + MOVSW + MOVSW + POP [$DAC+6] ;Restore argument to FAC + POP [$DAC+4] + POP [$DAC+2] + POP [$DAC] + MOV SI,OFFSET DC:$DAC + CALL COSF ;Compute cos(x) + MOV SI,OFFSET DC:$TEMP + MOV DI,OFFSET DC:$DAC + JMP $DDIV ;Tan = sin/cos + +$COD: ;Double precision cosine + CALL $SAVREG + MOV SI,BX +COSF: + MOV DI,OFFSET DC:$DRECIP2PI + CALL $DMUL + AND [$FAC-1],7FH ;Take absolute value - COS(X) = COS(-X) + MOV DI,OFFSET DC:$DAC + MOV SI,OFFSET DC:$DBL4TH + CALL $DSUB ;Use COS(X)=SIN(PI/2-X) + JMP SHORT SINCOS + +$SID: ;Double precision sine + CALL $SAVREG +SINF: + MOV SI,BX + MOV DI,OFFSET DC:$DRECIP2PI + CALL $DMUL +SINCOS: + MOV AL,[$FAC-1] ;Get sign + MOV [SIGN],AL + AND AL,7FH ;Take absolute value + MOV [$FAC-1],AL + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG + MOVSW ;Save X so far + MOVSW + MOVSW + MOVSW + MOV BX,OFFSET DC:$DAC + CALL $FID ;FAC=INT(X), X >= 0 + MOV SI,OFFSET DC:$ARG + MOV DI,OFFSET DC:$DAC + CALL $DSUB ;FAC= X - INT(X) (always positive or zero) + CMP [$FAC],7FH ;Is X < 1/4? (In first quadrant?) + JB FIGSIN ;If so, go compute + CMP [$DAC+6],8040H ;Is X >= 3/4? (In fourth quadrant?) + MOV SI,OFFSET DC:$DBLHALF + MOV DI,OFFSET DC:$DAC ;Subtract from 1/2 if in II or III + JB SUB + MOV SI,DI + MOV DI,OFFSET DC:$DBLONE ;Subtract 1 from it if in IV +SUB: + CALL $DSUB +FIGSIN: + MOV BX,OFFSET DC:SINTAB + CALL $DPOLYX + MOV AL,[SIGN] + AND AL,80H ;Reduce to sign bit + XOR [$FAC-1],AL ;Flip sign if input was negative + RET + +CODE ENDS + END From a7a81334adcbfa6fe3f2dc3284fe7a8cf909da7a Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 20 Jun 2026 17:14:30 -0700 Subject: [PATCH 12/53] Transcription of Bundle 9 - DMATH.ASM Code and Listing --- 2_printed_files/bundle_09/DMATH.ASM | 960 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DMATH.ASM | 751 ++++++++++++++++++++++ 2 files changed, 1711 insertions(+) create mode 100644 2_printed_files/bundle_09/DMATH.ASM create mode 100644 3_source_code/BASLIB-86/DMATH.ASM diff --git a/2_printed_files/bundle_09/DMATH.ASM b/2_printed_files/bundle_09/DMATH.ASM new file mode 100644 index 0000000..72be7d1 --- /dev/null +++ b/2_printed_files/bundle_09/DMATH.ASM @@ -0,0 +1,960 @@ +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-1 + + + + 1 TITLE DMATH - Double precision floating point arithmetic + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:BYTE,$DAC:WORD + 6 + 7 0000 ???? OP1MAN DW ? + 8 0002 ???? OP2MAN DW ? + 9 + 10 0004 DATA ENDS + 11 + 12 DC GROUP DATA + 13 + 14 0000 CODE SEGMENT WORD PUBLIC 'CODE' + 15 + 16 PUBLIC $FADB,$FADD,$FADF,$FADH,$FSUB,$FSUD,$FSUF,$FSUH + 17 PUBLIC $FMUB,$FMUD,$FMUF,$FMUH,$FDVB,$FDVD,$FDVF,$FDVH + 18 PUBLIC $DADD,$DSUB,$DMUL,$DDIV,PMULD,$DNORM,$DROUND + 19 + 20 EXTRN $OVFL:NEAR,$DIV0:NEAR,$SAVREG:NEAR,$GTMP:NEAR + 21 + 22 ASSUME CS:CODE, DS:DC, ES:DC + 23 + 24 + 25 0000 $FSUD: + 26 0000 BE 0000 E MOV SI,OFFSET DC:$DAC + 27 0003 EB 06 JMP SHORT $FSUB + 28 0005 $FSUH: + 29 0005 E8 0000 E CALL $GTMP + 30 0008 $FSUF: + 31 0008 BF 0000 E MOV DI,OFFSET DC:$DAC + 32 000B $FSUB: + 33 000B E8 0000 E CALL $SAVREG + 34 + 35 SUBTTL $DSUB and $DADD - Double precision subtraction and addition + 36 ; Inputs: + 37 ; SI = Address Of Subtrahend Or Addend + 38 ; DI = Address of Minuend or Addend + 39 ; Function: + 40 ; Subtract/Add the operands in double precision and leave result in + 41 ; $FAC. Performs rounding with sticky bit. + 42 ; Outputs: + 43 ; Result in $FAC. + 44 ; Registers: + 45 ; All except BP destroyed. + 46 + 47 000E $DSUB: + 48 000E 8B 4D 06 MOV CX,[DI+6] ;Get sign & exponent on subtrahend + 49 0011 80 F1 80 XOR CL,80H ;Invert its sign + 50 0014 EB 1C JMP SHORT DOADD ; and just add + 51 + 52 0016 SAVDI: + 53 0016 91 XCHG AX,CX + 54 0017 8B F7 MOV SI,DI + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-2 +$DSUB and $DADD - Double precision subtraction and addition + + + 55 0019 BF 0000 E MOV DI,OFFSET DC:$DAC + 56 001C A5 MOVSW + 57 001D A5 MOVSW + 58 001E A5 MOVSW + 59 001F AB STOSW + 60 0020 C3 RET + 61 + 62 0021 $FADD: + 63 0021 BE 0000 E MOV SI,OFFSET DC:$DAC + 64 0024 EB 06 JMP SHORT $FADB + 65 0026 $FADH: + 66 0026 E8 0000 E CALL $GTMP + 67 0029 $FADF: + 68 0029 BF 0000 E MOV DI,OFFSET DC:$DAC + 69 002C $FADB: + 70 002C E8 0000 E CALL $SAVREG + 71 + 72 002F $DADD: + 73 002F 8B 4D 06 MOV CX,[DI+6] ;Get sign & exponent of one operand + 74 0032 DOADD: + 75 0032 8B 44 06 MOV AX,[SI+6] ;Get sign & exponent of other operand + 76 0035 0A E4 OR AH,AH + 77 0037 74 DD JZ SAVDI + 78 0039 3A EC CMP CH,AH ;See which number is larger + 79 003B 77 07 JA SIGNFIDDLE ;See if difference is positive + 80 003D 87 F7 XCHG SI,DI ;Swap pointers to operands + 81 003F 91 XCHG AX,CX ;Swap exponents/signs + 82 0040 0A E4 OR AH,AH ;See if smaller operand is zero + 83 0042 74 D2 JZ SAVDI ;If so, return larger + 84 0044 SIGNFIDDLE: + 85 0044 2A E5 SUB AH,CH ;Subtract exponents ( <=0 ) + 86 0046 F6 DC NEG AH + 87 0048 80 FC 38 CMP AH,56 ;Is smaller argument significant? + 88 004B 77 C9 JA SAVDI + 89 004D D0 E0 SHL AL,1 ;Put sign of smaller into carry + 90 004F D0 D9 RCR CL,1 ;Now pack it in next to sign of larger + 91 0051 91 XCHG AX,CX + 92 0052 8A CD MOV CL,CH + 93 0054 B5 00 MOV CH,0 + 94 + 95 ; Now things look like this: + 96 ; SI has pointer to smaller operand + 97 ; DI has pointer to larger operand + 98 ; AL bit 7 has sign of smaller + 99 ; AL bit 6 has sign of larger + 100 ; CL has exponent difference ( 0 <= CL <= 56 ) + 101 ; CH is zero + 102 ; AH has exponent of larger ( = tentative exponent of result) + 103 + 104 0056 50 PUSH AX + 105 0057 57 PUSH DI ;We'll need these later + 106 0058 8B F9 MOV DI,CX ;Need all 8-bit registers + 107 + 108 ;Load smaller operand + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-3 +$DSUB and $DADD - Double precision subtraction and addition + + + 109 + 110 005A AC LODSB + 111 005B 8A E0 MOV AH,AL + 112 005D 32 C0 XOR AL,AL ;Extend operand to 64 bits with zeros + 113 005F 92 XCHG AX,DX + 114 0060 AD LODSW + 115 0061 91 XCHG AX,CX + 116 0062 AD LODSW + 117 0063 93 XCHG AX,BX + 118 0064 AD LODSW + 119 0065 80 CC 80 OR AH,80H ;Set implied bit + 120 + 121 ;Smaller operand now in AX:BX:CX:DX with implied bit set + 122 + 123 0068 0B FF OR DI,DI + 124 006A 74 63 JZ ALIGNED ;Alignment operations necessary? + 125 006C CHKALN: + 126 006C 83 FF 0E CMP DI,14 ;Do shifts of 16 bits by word rotate + 127 006F 7C 18 JL BYTSHFT ;If not enough for word, go try byte + 128 0071 0B D2 OR DX,DX ;See if we're shifting something off the end + 129 0073 74 03 JZ NOSTIK + 130 0075 80 C9 01 OR CL,1 ;Ensure sticky bit will be set + 131 0078 NOSTIK: + 132 0078 8B D1 MOV DX,CX + 133 007A 8B CB MOV CX,BX + 134 007C 8B D8 MOV BX,AX + 135 007E 33 C0 XOR AX,AX + 136 0080 83 EF 10 SUB DI,16 ;Counts for 16 bit shifts + 137 0083 77 E7 JA CHKALN ;If not enough, try again + 138 0085 74 48 JZ ALIGNED ;Hit it exactly? + 139 0087 72 23 JB SHFLEF ;Back up if too far + 140 + 141 0089 BYTSHFT: + 142 0089 83 FF 06 CMP DI,6 ;Can we do a byte shift? + 143 008C 7C 2B JL BITSHFT + 144 008E 0A D2 OR DL,DL + 145 0090 74 03 JZ NSTIK + 146 0092 80 CE 01 OR DH,1 + 147 0095 NSTIK: + 148 0095 8A D6 MOV DL,DH + 149 0097 8A F1 MOV DH,CL + 150 0099 8A CD MOV CL,CH + 151 009B 8A EB MOV CH,BL + 152 009D 8A DF MOV BL,BH + 153 009F 8A F8 MOV BH,AL + 154 00A1 8A C4 MOV AL,AH + 155 00A3 32 E4 XOR AH,AH + 156 00A5 83 EF 08 SUB DI,8 + 157 00A8 77 0F JA BITSHFT + 158 00AA 74 23 JZ ALIGNED + 159 + 160 ;To get here, we must have used a byte shift when we needed to shift less than + 161 ;8 bits. Now we must correct by 1 or 2 left shifts. + 162 + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-4 +$DSUB and $DADD - Double precision subtraction and addition + + + 163 00AC SHFLEF: + 164 00AC D1 E2 SHL DX,1 + 165 00AE D1 D1 RCL CX,1 + 166 00B0 D1 D3 RCL BX,1 + 167 00B2 D1 D0 RCL AX,1 + 168 00B4 47 INC DI + 169 00B5 75 F5 JNZ SHFLEF ;Until DI is back to zero (from -1 or -2) + 170 00B7 EB 16 JMP SHORT ALIGNED + 171 + 172 00B9 BITSHFT: + 173 00B9 87 CF XCHG CX,DI + 174 00BB F6 C2 3F TEST DL,3FH ;See if we're shifting stuff off the end + 175 00BE 74 03 JZ SHFRIG + 176 00C0 80 CA 20 OR DL,20H ;Set sticky bit if so + 177 00C3 SHFRIG: + 178 00C3 D1 E8 SHR AX,1 + 179 00C5 D1 DB RCR BX,1 + 180 00C7 D1 DF RCR DI,1 + 181 00C9 D1 DA RCR DX,1 + 182 00CB E2 F6 LOOP SHFRIG ;Do 1 to 5 64-bit right shifts + 183 00CD 87 CF XCHG CX,DI + 184 00CF ALIGNED: + 185 00CF 5E POP SI ;Address of larger operand + 186 00D0 97 XCHG AX,DI + 187 00D1 F6 C2 3F TEST DL,3FH ;Collapse LSBs into sticky bit + 188 00D4 74 03 JZ GETSIGN + 189 00D6 80 CA 20 OR DL,20H ;Set sticky bit + 190 00D9 GETSIGN: + 191 00D9 58 POP AX ;Recover sign and exponent + 192 00DA D0 E0 SHL AL,1 ;Shift sign bits out to test + 193 + 194 ;Now AL = sign of larger ( = tentative sign of result) + 195 ;Carry = sign of smaller. + 196 ;Overflow flag is set if these two are different. + 197 + 198 00DC 70 24 JO SUBMAN ;Subtract mantissas if signs are different + 199 00DE 02 34 ADD DH,[SI] + 200 00E0 13 4C 01 ADC CX,[SI+1] + 201 00E3 13 5C 03 ADC BX,[SI+3] + 202 00E6 9C PUSHF ;Save carry flag + 203 00E7 8B 74 05 MOV SI,[SI+5] + 204 00EA 81 CE 8000 OR SI,8000H ;Set implied bit + 205 00EE 9D POPF + 206 00EF 13 FE ADC DI,SI + 207 00F1 73 0A JNC ROUNDJ + 208 ;Have a carry, so result must be shifted right and exponent incremented + 209 00F3 D1 DF RCR DI,1 + 210 00F5 D1 DB RCR BX,1 + 211 00F7 D1 D9 RCR CX,1 + 212 00F9 D1 DA RCR DX,1 + 213 00FB FE C4 INC AH ;Bump exponent + 214 00FD 75 75 ROUNDJ: JNZ ROUND + 215 00FF E9 0000 E JMP $OVFL + 216 + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-5 +$DSUB and $DADD - Double precision subtraction and addition + + + 217 0102 SUBMAN: + 218 ;Subtract mantissas since signs are different. We'll be subtracting in larger + 219 ;from smaller, so sign will be inverted first. + 220 0102 F6 D0 NOT AL + 221 0104 2A 34 SUB DH,[SI] + 222 0106 1B 4C 01 SBB CX,[SI+1] + 223 0109 1B 5C 03 SBB BX,[SI+3] + 224 010C 9C PUSHF ;Save carry flag + 225 010D 8B 74 05 MOV SI,[SI+5] + 226 0110 81 CE 8000 OR SI,8000H ;Set implied bit + 227 0114 9D POPF + 228 0115 1B FE SBB DI,SI + 229 0117 73 13 JNC NORM ;Won't carry if we mixed up larger and smaller + 230 ;As expected, we got a carry which means we must negate the result + 231 0119 33 F6 XOR SI,SI ;We'll need a zero + 232 011B F6 D0 NOT AL ;Flip sign bit + 233 011D F7 D7 NOT DI + 234 011F F7 D3 NOT BX + 235 0121 F7 D1 NOT CX + 236 0123 F7 DA NEG DX ;Carry clear if zero + 237 0125 F5 CMC + 238 0126 13 CE ADC CX,SI + 239 0128 13 DE ADC BX,SI + 240 012A 13 FE ADC DI,SI + 241 012C $DNORM: + 242 012C NORM: + 243 012C BE 0004 MOV SI,4 ;Maximum of 4 word shifts + 244 012F DNOR: + 245 012F 0B FF OR DI,DI ;See if any bits on in high word + 246 0131 75 12 JNZ HIBYT ;If so, go check high byte for zero + 247 0133 80 EC 10 SUB AH,16 ;Drop exponent by shift count + 248 0136 76 7C JBE ZERO + 249 0138 4E DEC SI + 250 0139 74 79 JZ ZERO + 251 013B 8B FB MOV DI,BX + 252 013D 8B D9 MOV BX,CX + 253 013F 8B CA MOV CX,DX + 254 0141 33 D2 XOR DX,DX + 255 0143 EB EA JMP DNOR + 256 0145 HIBYT: + 257 0145 F7 C7 FF00 TEST DI,0FF00H ;See if high byte is zero + 258 0149 75 19 JNZ NORMSHF + 259 014B 80 EC 08 SUB AH,8 ;Drop exponent by shift amount + 260 014E 76 64 JBE ZERO + 261 0150 97 XCHG AX,DI + 262 0151 8A E0 MOV AH,AL + 263 0153 8A C7 MOV AL,BH + 264 0155 8A FB MOV BH,BL + 265 0157 8A DD MOV BL,CH + 266 0159 8A E9 MOV CH,CL + 267 015B 8A CE MOV CL,DH + 268 015D 8A F2 MOV DH,DL + 269 015F B2 00 MOV DL,0 + 270 0161 0A E4 OR AH,AH + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-6 +$DSUB and $DADD - Double precision subtraction and addition + + + 271 0163 97 XCHG AX,DI + 272 0164 NORMSHF: + 273 0164 78 0E JS ROUND ;Normalize complete? + 274 0166 NORMLP: + 275 0166 FE CC DEC AH ;Account for shift in exponent + 276 0168 74 4A JZ ZERO + 277 016A D1 E2 SHL DX,1 + 278 016C D1 D1 RCL CX,1 + 279 016E D1 D3 RCL BX,1 + 280 0170 D1 D7 RCL DI,1 + 281 0172 71 F2 JNO NORMLP ;Overflow will be set when sign bit changes + 282 + 283 0174 $DROUND: + 284 0174 ROUND: + 285 0174 80 FA 80 CMP DL,80H ;Check extended bits + 286 0177 77 07 JA ROUNDUP + 287 0179 72 17 JB SAVE + 288 ;Extended bits equal exactly one-half LSB, so round even + 289 017B F6 C6 01 TEST DH,1 ;Already even? + 290 017E 74 12 JZ SAVE + 291 0180 ROUNDUP: + 292 0180 80 C6 01 ADD DH,1 + 293 0183 83 D1 00 ADC CX,0 + 294 0186 83 D3 00 ADC BX,0 ;Propagate carry + 295 0189 83 D7 00 ADC DI,0 + 296 018C 73 04 JNC SAVE ;Overflow? + 297 ;If we overflowed, DI:BX:CX:DH must now be zero, so we can leave it that way. + 298 018E FE C4 INC AH ;Increment exponent + 299 0190 74 1F JZ OVERFLOW + 300 0192 SAVE: + 301 0192 24 80 AND AL,80H ;Strip to sign bit + 302 0194 87 DF XCHG BX,DI + 303 0196 80 E7 7F AND BH,7FH ;Mask off implied bit + 304 0199 0A C7 OR AL,BH ;Combine sign with mantissa + 305 019B A3 0006 E MOV [$DAC+6],AX + 306 019E 88 1E FFFE E MOV [$FAC-2],BL + 307 01A2 8B DF MOV BX,DI + 308 01A4 BF 0000 E MOV DI,OFFSET DC:$DAC + 309 01A7 8A C6 MOV AL,DH + 310 01A9 AA STOSB + 311 01AA 91 XCHG AX,CX + 312 01AB AB STOSW + 313 01AC 93 XCHG AX,BX + 314 01AD AB STOSW + 315 01AE C3 RET + 316 + 317 01AF OVCHK: + 318 01AF 79 03 JNS ZERO + 319 01B1 OVERFLOW: + 320 01B1 E9 0000 E JMP $OVFL + 321 + 322 01B4 ZERO: + 323 01B4 C6 06 0000 E 00 MOV [$FAC],0 + 324 01B9 C3 RET + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-7 +$DSUB and $DADD - Double precision subtraction and addition + + + 325 + 326 + 327 01BA $FMUD: + 328 01BA BE 0000 E MOV SI,OFFSET DC:$DAC + 329 01BD EB 06 JMP SHORT $FMUB + 330 01BF $FMUH: + 331 01BF E8 0000 E CALL $GTMP + 332 01C2 $FMUF: + 333 01C2 BF 0000 E MOV DI,OFFSET DC:$DAC + 334 01C5 $FMUB: + 335 01C5 E8 0000 E CALL $SAVREG + 336 + 337 SUBTTL $DMUL - Double precision multiply + 338 ; Inputs: + 339 ; SI = Address of one operand + 340 ; DI = Address of other operand + 341 ; Function: + 342 ; Multiply with result in FAC. + 343 ; Outputs: + 344 ; Result in FAC. + 345 ; Registers: + 346 ; Uses ALL. + 347 + 348 01C8 $DMUL: + 349 01C8 8B 44 06 MOV AX,[SI+6] ;High part of op1 + 350 01CB 0A E4 OR AH,AH + 351 01CD 74 E5 JZ ZERO + 352 01CF 8B 4D 06 MOV CX,[DI+6] ;High part of op2 + 353 01D2 0A ED OR CH,CH + 354 01D4 74 DE JZ ZERO + 355 01D6 32 C1 XOR AL,CL ;Compute sign + 356 + 357 ;Exponent computation. + 358 ;Compute sum of exponents minus one. The minus one is valid if the product + 359 ;will need normalization by one bit. If it doesn't, one will be added to the + 360 ;exponent. A zero exponent will temporarily be OK because of this possibility + 361 ;of adding one later. + 362 + 363 01D8 80 EC 81 SUB AH,128+1 ;Subtract bias and extra "minus one" + 364 01DB 80 ED 80 SUB CH,128 + 365 01DE 02 E5 ADD AH,CH ;Add exponents + 366 01E0 70 CD OVCHKJ: JO OVCHK ;If overflow, check whether up or down + 367 01E2 80 C4 80 ADD AH,128 ;Put bias back in + 368 01E5 50 PUSH AX ;Save sign and tentative exponent + 369 01E6 E8 030B R CALL PMULD ;Multiply mantissas + 370 01E9 74 03 JZ NORMCHK ;Need to set sticky bit? + 371 01EB 80 CA 01 OR DL,1 + 372 01EE NORMCHK: + 373 01EE 58 POP AX ;Get exp. and sign back + 374 01EF 0B FF OR DI,DI ;See if normalized + 375 01F1 78 0E JS INCEXP ;Yes - increment exponent + 376 01F3 D1 E2 SHL DX,1 ;Normalize + 377 01F5 D1 D1 RCL CX,1 + 378 01F7 D1 D3 RCL BX,1 + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-8 +$DMUL - Double precision multiply + + + 379 01F9 D1 D7 RCL DI,1 + 380 01FB 0A E4 OR AH,AH ;Is exponent zero? + 381 01FD 75 06 JNZ RNDJMP + 382 01FF EB B3 JMP ZERO + 383 + 384 0201 INCEXP: + 385 0201 FE C4 INC AH + 386 0203 74 AC JZ OVERFLOW + 387 0205 E9 0174 R RNDJMP: JMP ROUND + 388 + 389 + 390 0208 $FDVD: + 391 0208 BE 0000 E MOV SI,OFFSET DC:$DAC + 392 020B EB 06 JMP SHORT $FDVB + 393 020D $FDVH: + 394 020D E8 0000 E CALL $GTMP + 395 0210 $FDVF: + 396 0210 BF 0000 E MOV DI,OFFSET DC:$DAC + 397 0213 $FDVB: + 398 0213 E8 0000 E CALL $SAVREG + 399 + 400 SUBTTL $DDIV - Double precision divide + 401 ; Inputs: + 402 ; SI = Address of Dividend (Numerator) + 403 ; DI = Address of Divisor (Denominator) + 404 ; Function: + 405 ; Compute [SI] / [DI] + 406 ; Outputs: + 407 ; Result in FAC. + 408 ; Registers: + 409 ; All destroyed. + 410 + 411 0216 $DDIV: + 412 0216 8B 44 06 MOV AX,[SI+6] ;High half of numerator + 413 0219 8B 4D 06 MOV CX,[DI+6] ;High half of denominator + 414 021C 32 C1 XOR AL,CL ;Compute sign + 415 021E 0A ED OR CH,CH ;Denominator zero? + 416 0220 74 62 JZ DIV0 + 417 0222 0A E4 OR AH,AH ;Numerator zero? + 418 0224 74 8E JZ ZERO + 419 0226 80 EC 80 SUB AH,128 ;Removebias from exponents + 420 0229 80 ED 80 SUB CH,128 + 421 022C 2A E5 SUB AH,CH ;Compute result exponent + 422 022E 70 B0 JO OVCHKJ + 423 + 424 ;AH has the (tentative) true exponent of the result. It is correct if the + 425 ;result needs normalizing one bit. If not, 1 will be added to it. A true + 426 ;exponent of -128, not normally allowed except to represent zero, is OK + 427 ;here because of this possible future incrementing. + 428 + 429 0230 80 C4 80 ADD AH,128 ;Put bias back + 430 0233 50 PUSH AX ;Save sign and exponent + 431 0234 AC LODSB ;Load up dividend + 432 0235 8A E8 MOV CH,AL + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-9 +$DDIV - Double precision divide + + + 433 0237 32 C9 XOR CL,CL + 434 0239 AD LODSW + 435 023A 93 XCHG AX,BX + 436 023B AD LODSW + 437 023C 92 XCHG AX,DX + 438 023D AD LODSW + 439 023E 80 CC 80 OR AH,80H ;Set implied bit + 440 0241 92 XCHG AX,DX ;Divisor in DX:AX:BX:CX + 441 + 442 ;Move divisor to FAC so we can get at it easily. More importantly, get it in + 443 ;the necessary form - extended to 64 bits with zeros, implied bit set. + 444 ;The form we want it in will have the mantissa MSB where the exponent usually + 445 ;is, so by moving high to low we will not destroy the divisor even if it is + 446 ;already in the FAC. + 447 + 448 0242 8B F7 MOV SI,DI + 449 0244 83 C6 05 ADD SI,5 ;Point to high end of divisor + 450 0247 BF FFFF E MOV DI,OFFSET DC:$FAC-1 + 451 024A FD STD ;Direction DOWN + 452 024B A5 MOVSW ;Move divisor to FAC + 453 024C A5 MOVSW + 454 024D A5 MOVSW + 455 024E 46 INC SI + 456 024F 47 INC DI + 457 0250 A4 MOVSB + 458 0251 FC CLD ;Restore direction + 459 0252 C6 05 00 MOV BYTE PTR[DI],0 ;Extend to 64 bits with a zero + 460 0255 80 0E 0000 E 80 OR [$FAC],80H ;Set implied bit + 461 + 462 ;Now we're all set: + 463 ; DX:AX:BX:CX has dividend + 464 ; FAC has divisor (not in normal format) + 465 ;Both are extended to 64 bits with zeros and have implied bit set. + 466 ;Top of stack has sign and tentative exponent. + 467 + 468 025A D1 EA SHR DX,1 ;Make sure dividend is smaller than divisor + 469 025C D1 D8 RCR AX,1 ; by dividing it by two + 470 025E D1 DB RCR BX,1 + 471 0260 D1 D9 RCR CX,1 + 472 0262 E8 0287 R CALL DIV16 ;Get a quotient digit + 473 0265 57 PUSH DI + 474 0266 E8 0287 R CALL DIV16 + 475 0269 57 PUSH DI + 476 026A E8 0287 R CALL DIV16 + 477 026D 57 PUSH DI + 478 026E E8 0287 R CALL DIV16 + 479 0271 0B C3 OR AX,BX ;Remainder zero? + 480 0273 0B C1 OR AX,CX + 481 0275 0B C2 OR AX,DX + 482 0277 8B D7 MOV DX,DI ;Get lowest word in position + 483 0279 74 03 JZ NSTK1 + 484 027B 80 CA 01 OR DL,1 ;Set sticky bit if not + 485 027E NSTK1: + 486 027E 59 POP CX ;Recover quotient digits + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-10 +$DDIV - Double precision divide + + + 487 027F 5B POP BX + 488 0280 5F POP DI + 489 0281 E9 01EE R JMP NORMCHK + 490 + 491 0284 E9 0000 E DIV0: JMP $DIV0 + 492 + 493 0287 DIV16: + 494 0287 8B 36 0006 E MOV SI,[$DAC+6] ;Get high word of divisor + 495 028B 33 FF XOR DI,DI ;Initialize quotient digit to zero + 496 028D 3B D6 CMP DX,SI ;Will we overflow? + 497 028F 73 5C JAE MAXQUO ;If so, go handle special + 498 0291 0B D2 OR DX,DX ;Is dividend small? + 499 0293 75 04 JNZ DODIV + 500 0295 3B F0 CMP SI,AX ;Will divisor fit at all? + 501 0297 77 3B JA ZERQUO ;No - quotient is zero + 502 0299 DODIV: + 503 0299 F7 F6 DIV SI ;AX is our digit "guess" + 504 029B 52 PUSH DX ;Save remainder + 505 029C 97 XCHG AX,DI ;Quotient digit in DI + 506 029D 33 ED XOR BP,BP ;Initialize quotient * divisor + 507 029F 8B F5 MOV SI,BP + 508 02A1 A1 0000 E MOV AX,[$DAC] + 509 02A4 0B C0 OR AX,AX ;If zero, save multiply time + 510 02A6 74 04 JZ REM2 + 511 02A8 F7 E7 MUL DI ;Begin computing quotient * divisor + 512 02AA 8B F2 MOV SI,DX + 513 02AC REM2: + 514 02AC 50 PUSH AX ;Save lowest word of quotient * divisor + 515 02AD A1 0002 E MOV AX,[$DAC+2] + 516 02B0 0B C0 OR AX,AX + 517 02B2 74 06 JZ REM3 + 518 02B4 F7 E7 MUL DI + 519 02B6 03 F0 ADD SI,AX + 520 02B8 13 EA ADC BP,DX + 521 02BA REM3: + 522 02BA A1 0004 E MOV AX,[$DAC+4] + 523 02BD 0B C0 OR AX,AX + 524 02BF 74 08 JZ REM4 + 525 02C1 F7 E7 MUL DI + 526 02C3 03 E8 ADD BP,AX + 527 02C5 83 D2 00 ADC DX,0 + 528 02C8 92 XCHG AX,DX + 529 02C9 REM4: ;Quotient * divisor in AX:BP:SI:[SP] + 530 02C9 5A POP DX ;Recover lowest word of quotient * divisor + 531 02CA F7 DA NEG DX ;Subtract from dividend + 532 02CC 1B CE SBB CX,SI + 533 02CE 1B DD SBB BX,BP + 534 02D0 5D POP BP ;Remainder from DIV + 535 02D1 1B E8 SBB BP,AX + 536 02D3 95 XCHG AX,BP + 537 02D4 ZERQUO: ;Remainder in AX:BX:CX:DX + 538 02D4 92 XCHG AX,DX + 539 02D5 91 XCHG AX,CX + 540 02D6 93 XCHG AX,BX + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-11 +$DDIV - Double precision divide + + + 541 02D7 73 13 JNC RET ;Remainder in DX:AX:BX:CX + 542 02D9 RESTORE: + 543 02D9 4F DEC DI ;Drop quotient since it didn't fit + 544 02DA 03 0E 0000 E ADD CX,[$DAC] ;Add divisor back in until remainder goes + + 545 02DE 13 1E 0002 E ADC BX,[$DAC+2] + 546 02E2 13 06 0004 E ADC AX,[$DAC+4] + 547 02E6 13 16 0006 E ADC DX,[$DAC+6] + 548 02EA 73 ED JNC RESTORE + 549 02EC C3 RET: RET + 550 + 551 02ED MAXQUO: + 552 02ED 4F DEC DI ;DI=FFFF=2**16-1 + 553 02EE 2B 0E 0000 E SUB CX,[$DAC] + 554 02F2 1B 1E 0002 E SBB BX,[$DAC+2] + 555 02F6 1B 06 0004 E SBB AX,[$DAC+4] + 556 02FA 03 0E 0002 E ADD CX,[$DAC+2] + 557 02FE 13 1E 0004 E ADC BX,[$DAC+4] + 558 0302 13 C2 ADC AX,DX + 559 0304 8B 16 0000 E MOV DX,[$DAC] + 560 0308 F5 CMC + 561 0309 EB C9 JMP ZERQUO + 562 + 563 + 564 SUBTTL PMULD - Partial DP multiply + 565 + 566 ; Inputs: + 567 ; SI = Address of multiplicand + 568 ; DI = Address of multiplier + 569 ; Function: + 570 ; Multiply mantissas and provide unrounded 64 bit result. + 571 ; Outputs: + 572 ; Result in DI:BX:CX:DX. + 573 ; SI is non-zero (flags set accordingly) if not exact result + 574 ; Registers: + 575 ; Uses ALL. + 576 + 577 030B PMULD: + 578 030B 8A 44 06 MOV AL,[SI+6] ;Get most significant mantissa byte + 579 030E B4 00 MOV AH,0 ;Extend with a zero + 580 0310 0C 80 OR AL,80H ;Set implied bit + 581 0312 A3 0000 R MOV [OP1MAN],AX ;Save for easy access + 582 0315 8A 45 06 MOV AL,[DI+6] + 583 0318 B4 00 MOV AH,0 + 584 031A 0C 80 OR AL,80H + 585 031C A3 0002 R MOV [OP2MAN],AX ;Second operand similarly prepared + 586 + 587 ; Perform multiply by summing partial products of 16x16 hardware multiply. + 588 ; Before each multiply, the operands are checked for zero to see if it can be + 589 ; skipped, since it's a slow operation on the 8086. The sum is kept in + 590 ; registers as much as possible. Any insignificant bits lost are ORed together + 591 ; and kept in a word on the top of the stack. This can be used for sticky bit + 592 ; rounding. + 593 + 594 031F 33 DB XOR BX,BX + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-12 +PMULD - Partial DP multiply + + + 595 0321 8B EB MOV BP,BX + 596 0323 8B 0C MOV CX,[SI] + 597 0325 E3 1A JCXZ PROD3 ;Skip 2 multiplies if zero + 598 0327 91 XCHG AX,CX + 599 0328 8B 0D MOV CX,[DI] + 600 032A E3 08 JCXZ PROD2 + 601 032C F7 E1 MUL CX + 602 032E 8B E8 MOV BP,AX ;Save insignificant bits + 603 0330 8B CA MOV CX,DX + 604 0332 8B 04 MOV AX,[SI] + 605 0334 PROD2: ;Partial result in CX + 606 0334 8B 55 02 MOV DX,[DI+2] + 607 0337 0B D2 OR DX,DX + 608 0339 74 06 JZ PROD3 + 609 033B F7 E2 MUL DX + 610 033D 03 C8 ADD CX,AX + 611 033F 13 DA ADC BX,DX + 612 0341 PROD3: ;Partial result in BX:CX + 613 0341 55 PUSH BP ;Save insignificant bits on stack + 614 0342 33 ED XOR BP,BP + 615 0344 8B 44 02 MOV AX,[SI+2] + 616 0347 0B C0 OR AX,AX + 617 0349 74 0E JZ PROD4 + 618 034B 8B 15 MOV DX,[DI] + 619 034D 0B D2 OR DX,DX + 620 034F 74 08 JZ PROD4 + 621 0351 F7 E2 MUL DX + 622 0353 03 C8 ADD CX,AX + 623 0355 13 DA ADC BX,DX + 624 0357 D1 D5 RCL BP,1 ;Pick up carry + 625 0359 PROD4: ;Partial result in BP:BX:CX + 626 0359 58 POP AX + 627 035A 0B C1 OR AX,CX ;Record these bits before we throw them away + 628 035C 50 PUSH AX + 629 035D 8B 44 02 MOV AX,[SI+2] + 630 0360 0B C0 OR AX,AX + 631 0362 74 0D JZ PROD5 + 632 0364 8B 55 02 MOV DX,[DI+2] + 633 0367 0B D2 OR DX,DX + 634 0369 74 06 JZ PROD5 + 635 036B F7 E2 MUL DX + 636 036D 03 D8 ADD BX,AX + 637 036F 13 EA ADC BP,DX + 638 0371 PROD5: ;Partial result in BP:BX + 639 0371 33 C9 XOR CX,CX + 640 0373 8B 04 MOV AX,[SI] + 641 0375 0B C0 OR AX,AX + 642 0377 74 0F JZ PROD6 + 643 0379 8B 55 04 MOV DX,[DI+4] + 644 037C 0B D2 OR DX,DX + 645 037E 74 08 JZ PROD6 + 646 0380 F7 E2 MUL DX + 647 0382 03 D8 ADD BX,AX + 648 0384 13 EA ADC BP,DX + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-13 +PMULD - Partial DP multiply + + + 649 0386 D1 D1 RCL CX,1 + 650 0388 PROD6: ;Partial result in CX:BP:BX + 651 0388 8B 44 04 MOV AX,[SI+4] + 652 038B 0B C0 OR AX,AX + 653 038D 74 0F JZ PROD7 + 654 038F 8B 15 MOV DX,[DI] + 655 0391 0B D2 OR DX,DX + 656 0393 74 09 JZ PROD7 + 657 0395 F7 E2 MUL DX + 658 0397 03 D8 ADD BX,AX + 659 0399 13 EA ADC BP,DX + 660 039B 83 D1 00 ADC CX,0 + 661 039E PROD7: ;Partial result in CX:BP:BX + 662 039E 58 POP AX + 663 039F 0B C3 OR AX,BX + 664 03A1 50 PUSH AX + 665 03A2 8B 04 MOV AX,[SI] + 666 03A4 0B C0 OR AX,AX + 667 03A6 74 08 JZ PROD8 + 668 03A8 F7 26 0002 R MUL [OP2MAN] + 669 03AC 03 E8 ADD BP,AX + 670 03AE 13 CA ADC CX,DX + 671 03B0 PROD8: ;Partial result in CX:BP + 672 03B0 8B 05 MOV AX,[DI] + 673 03B2 0B C0 OR AX,AX + 674 03B4 74 08 JZ PROD9 + 675 03B6 F7 26 0000 R MUL [OP1MAN] + 676 03BA 03 E8 ADD BP,AX + 677 03BC 13 CA ADC CX,DX + 678 03BE PROD9: ;Partial result in CX:BP + 679 03BE 33 DB XOR BX,BX + 680 03C0 8B 44 02 MOV AX,[SI+2] + 681 03C3 0B C0 OR AX,AX + 682 03C5 74 0F JZ PROD10 + 683 03C7 8B 55 04 MOV DX,[DI+4] + 684 03CA 0B D2 OR DX,DX + 685 03CC 74 08 JZ PROD10 + 686 03CE F7 E2 MUL DX + 687 03D0 03 E8 ADD BP,AX + 688 03D2 13 CA ADC CX,DX + 689 03D4 D1 D3 RCL BX,1 + 690 03D6 PROD10: ;Partial result in BX:CX:BP + 691 03D6 8B 44 04 MOV AX,[SI+4] + 692 03D9 0B C0 OR AX,AX + 693 03DB 74 10 JZ PROD11 + 694 03DD 8B 55 02 MOV DX,[DI+2] + 695 03E0 0B D2 OR DX,DX + 696 03E2 74 09 JZ PROD11 + 697 03E4 F7 E2 MUL DX + 698 03E6 03 E8 ADD BP,AX + 699 03E8 13 CA ADC CX,DX + 700 03EA 83 D3 00 ADC BX,0 + 701 03ED PROD11: ;Partial result in BX:CX:BP + 702 03ED 55 PUSH BP ;Not enough registers to keep LSW + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Page 1-14 +PMULD - Partial DP multiply + + + 703 03EE 33 ED XOR BP,BP + 704 03F0 8B 45 02 MOV AX,[DI+2] + 705 03F3 0B C0 OR AX,AX + 706 03F5 74 08 JZ PROD12 + 707 03F7 F7 26 0000 R MUL [OP1MAN] + 708 03FB 03 C8 ADD CX,AX + 709 03FD 13 DA ADC BX,DX + 710 03FF PROD12: ;Partial result in BP:BX:CX + 711 03FF 8B 44 02 MOV AX,[SI+2] + 712 0402 0B C0 OR AX,AX + 713 0404 74 08 JZ PROD13 + 714 0406 F7 26 0002 R MUL [OP2MAN] + 715 040A 03 C8 ADD CX,AX + 716 040C 13 DA ADC BX,DX + 717 040E PROD13: ;Partial result in BP:BX:CX + 718 040E 8B 44 04 MOV AX,[SI+4] + 719 0411 0B C0 OR AX,AX + 720 0413 74 1A JZ PROD15 + 721 0415 8B 55 04 MOV DX,[DI+4] + 722 0418 0B D2 OR DX,DX + 723 041A 74 0B JZ PROD14 + 724 041C F7 E2 MUL DX + 725 041E 03 C8 ADD CX,AX + 726 0420 13 DA ADC BX,DX + 727 0422 D1 D5 RCL BP,1 + 728 0424 8B 44 04 MOV AX,[SI+4] + 729 0427 PROD14: ;Partial result in BP:BX:CX + 730 0427 F7 26 0002 R MUL [OP2MAN] + 731 042B 03 D8 ADD BX,AX + 732 042D 13 EA ADC BP,DX + 733 042F PROD15: ;Partial result in BP:BX:CX + 734 042F 8B 45 04 MOV AX,[DI+4] + 735 0432 0B C0 OR AX,AX + 736 0434 74 08 JZ PROD16 + 737 0436 F7 26 0000 R MUL [OP1MAN] + 738 043A 03 D8 ADD BX,AX + 739 043C 13 EA ADC BP,DX + 740 043E PROD16: ;Partial result in BP:BX:CX + 741 043E A0 0000 R MOV AL,BYTE PTR[OP1MAN] + 742 0441 F6 26 0002 R MUL BYTE PTR[OP2MAN] + 743 0445 03 C5 ADD AX,BP + 744 0447 97 XCHG AX,DI + 745 0448 5A POP DX ;Get least significant bits + 746 0449 5E POP SI ;Get trimmed bits + 747 044A 0B F6 OR SI,SI ;Set flags + 748 044C C3 RET + 749 + 750 044D CODE ENDS + 751 END + + + + + + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 044D WORD PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0004 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ALIGNED. . . . . . . . . . . . . L NEAR 00CF CODE +BITSHFT. . . . . . . . . . . . . L NEAR 00B9 CODE +BYTSHFT. . . . . . . . . . . . . L NEAR 0089 CODE +CHKALN . . . . . . . . . . . . . L NEAR 006C CODE +DIV0 . . . . . . . . . . . . . . L NEAR 0284 CODE +DIV16. . . . . . . . . . . . . . L NEAR 0287 CODE +DNOR . . . . . . . . . . . . . . L NEAR 012F CODE +DOADD. . . . . . . . . . . . . . L NEAR 0032 CODE +DODIV. . . . . . . . . . . . . . L NEAR 0299 CODE +GETSIGN. . . . . . . . . . . . . L NEAR 00D9 CODE +HIBYT. . . . . . . . . . . . . . L NEAR 0145 CODE +INCEXP . . . . . . . . . . . . . L NEAR 0201 CODE +MAXQUO . . . . . . . . . . . . . L NEAR 02ED CODE +NORM . . . . . . . . . . . . . . L NEAR 012C CODE +NORMCHK. . . . . . . . . . . . . L NEAR 01EE CODE +NORMLP . . . . . . . . . . . . . L NEAR 0166 CODE +NORMSHF. . . . . . . . . . . . . L NEAR 0164 CODE +NOSTIK . . . . . . . . . . . . . L NEAR 0078 CODE +NSTIK. . . . . . . . . . . . . . L NEAR 0095 CODE +NSTK1. . . . . . . . . . . . . . L NEAR 027E CODE +OP1MAN . . . . . . . . . . . . . L WORD 0000 DATA +OP2MAN . . . . . . . . . . . . . L WORD 0002 DATA +OVCHK. . . . . . . . . . . . . . L NEAR 01AF CODE +OVCHKJ . . . . . . . . . . . . . L NEAR 01E0 CODE +OVERFLOW . . . . . . . . . . . . L NEAR 01B1 CODE +PMULD. . . . . . . . . . . . . . L NEAR 030B CODE Global +PROD10 . . . . . . . . . . . . . L NEAR 03D6 CODE +PROD11 . . . . . . . . . . . . . L NEAR 03ED CODE +PROD12 . . . . . . . . . . . . . L NEAR 03FF CODE +PROD13 . . . . . . . . . . . . . L NEAR 040E CODE +PROD14 . . . . . . . . . . . . . L NEAR 0427 CODE +PROD15 . . . . . . . . . . . . . L NEAR 042F CODE +PROD16 . . . . . . . . . . . . . L NEAR 043E CODE +PROD2. . . . . . . . . . . . . . L NEAR 0334 CODE +PROD3. . . . . . . . . . . . . . L NEAR 0341 CODE +PROD4. . . . . . . . . . . . . . L NEAR 0359 CODE +PROD5. . . . . . . . . . . . . . L NEAR 0371 CODE +PROD6. . . . . . . . . . . . . . L NEAR 0388 CODE +PROD7. . . . . . . . . . . . . . L NEAR 039E CODE +PROD8. . . . . . . . . . . . . . L NEAR 03B0 CODE +PROD9. . . . . . . . . . . . . . L NEAR 03BE CODE +REM2 . . . . . . . . . . . . . . L NEAR 02AC CODE + + +DMATH - Double precision floating point arithmetic Macro-86 %1(12) 0:59:49 13-Nov-81 Symbols-2 + + + +REM3 . . . . . . . . . . . . . . L NEAR 02BA CODE +REM4 . . . . . . . . . . . . . . L NEAR 02C9 CODE +RESTORE. . . . . . . . . . . . . L NEAR 02D9 CODE +RET. . . . . . . . . . . . . . . L NEAR 02EC CODE +RNDJMP . . . . . . . . . . . . . L NEAR 0205 CODE +ROUND. . . . . . . . . . . . . . L NEAR 0174 CODE +ROUNDJ . . . . . . . . . . . . . L NEAR 00FD CODE +ROUNDUP. . . . . . . . . . . . . L NEAR 0180 CODE +SAVDI. . . . . . . . . . . . . . L NEAR 0016 CODE +SAVE . . . . . . . . . . . . . . L NEAR 0192 CODE +SHFLEF . . . . . . . . . . . . . L NEAR 00AC CODE +SHFRIG . . . . . . . . . . . . . L NEAR 00C3 CODE +SIGNFIDDLE . . . . . . . . . . . L NEAR 0044 CODE +SUBMAN . . . . . . . . . . . . . L NEAR 0102 CODE +ZERO . . . . . . . . . . . . . . L NEAR 01B4 CODE +ZERQUO . . . . . . . . . . . . . L NEAR 02D4 CODE +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DADD. . . . . . . . . . . . . . L NEAR 002F CODE Global +$DDIV. . . . . . . . . . . . . . L NEAR 0216 CODE Global +$DIV0. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DMUL. . . . . . . . . . . . . . L NEAR 01C8 CODE Global +$DNORM . . . . . . . . . . . . . L NEAR 012C CODE Global +$DROUND. . . . . . . . . . . . . L NEAR 0174 CODE Global +$DSUB. . . . . . . . . . . . . . L NEAR 000E CODE Global +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FADB. . . . . . . . . . . . . . L NEAR 002C CODE Global +$FADD. . . . . . . . . . . . . . L NEAR 0021 CODE Global +$FADF. . . . . . . . . . . . . . L NEAR 0029 CODE Global +$FADH. . . . . . . . . . . . . . L NEAR 0026 CODE Global +$FDVB. . . . . . . . . . . . . . L NEAR 0213 CODE Global +$FDVD. . . . . . . . . . . . . . L NEAR 0208 CODE Global +$FDVF. . . . . . . . . . . . . . L NEAR 0210 CODE Global +$FDVH. . . . . . . . . . . . . . L NEAR 020D CODE Global +$FMUB. . . . . . . . . . . . . . L NEAR 01C5 CODE Global +$FMUD. . . . . . . . . . . . . . L NEAR 01BA CODE Global +$FMUF. . . . . . . . . . . . . . L NEAR 01C2 CODE Global +$FMUH. . . . . . . . . . . . . . L NEAR 01BF CODE Global +$FSUB. . . . . . . . . . . . . . L NEAR 000B CODE Global +$FSUD. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FSUF. . . . . . . . . . . . . . L NEAR 0008 CODE Global +$FSUH. . . . . . . . . . . . . . L NEAR 0005 CODE Global +$GTMP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$OVFL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + diff --git a/3_source_code/BASLIB-86/DMATH.ASM b/3_source_code/BASLIB-86/DMATH.ASM new file mode 100644 index 0000000..77ff524 --- /dev/null +++ b/3_source_code/BASLIB-86/DMATH.ASM @@ -0,0 +1,751 @@ + TITLE DMATH - Double precision floating point arithmetic + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE,$DAC:WORD + +OP1MAN DW ? +OP2MAN DW ? + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT WORD PUBLIC 'CODE' + + PUBLIC $FADB,$FADD,$FADF,$FADH,$FSUB,$FSUD,$FSUF,$FSUH + PUBLIC $FMUB,$FMUD,$FMUF,$FMUH,$FDVB,$FDVD,$FDVF,$FDVH + PUBLIC $DADD,$DSUB,$DMUL,$DDIV,PMULD,$DNORM,$DROUND + + EXTRN $OVFL:NEAR,$DIV0:NEAR,$SAVREG:NEAR,$GTMP:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +$FSUD: + MOV SI,OFFSET DC:$DAC + JMP SHORT $FSUB +$FSUH: + CALL $GTMP +$FSUF: + MOV DI,OFFSET DC:$DAC +$FSUB: + CALL $SAVREG + + SUBTTL $DSUB and $DADD - Double precision subtraction and addition +; Inputs: +; SI = Address Of Subtrahend Or Addend +; DI = Address of Minuend or Addend +; Function: +; Subtract/Add the operands in double precision and leave result in +; $FAC. Performs rounding with sticky bit. +; Outputs: +; Result in $FAC. +; Registers: +; All except BP destroyed. + +$DSUB: + MOV CX,[DI+6] ;Get sign & exponent on subtrahend + XOR CL,80H ;Invert its sign + JMP SHORT DOADD ; and just add + +SAVDI: + XCHG AX,CX + MOV SI,DI + MOV DI,OFFSET DC:$DAC + MOVSW + MOVSW + MOVSW + STOSW + RET + +$FADD: + MOV SI,OFFSET DC:$DAC + JMP SHORT $FADB +$FADH: + CALL $GTMP +$FADF: + MOV DI,OFFSET DC:$DAC +$FADB: + CALL $SAVREG + +$DADD: + MOV CX,[DI+6] ;Get sign & exponent of one operand +DOADD: + MOV AX,[SI+6] ;Get sign & exponent of other operand + OR AH,AH + JZ SAVDI + CMP CH,AH ;See which number is larger + JA SIGNFIDDLE ;See if difference is positive + XCHG SI,DI ;Swap pointers to operands + XCHG AX,CX ;Swap exponents/signs + OR AH,AH ;See if smaller operand is zero + JZ SAVDI ;If so, return larger +SIGNFIDDLE: + SUB AH,CH ;Subtract exponents ( <=0 ) + NEG AH + CMP AH,56 ;Is smaller argument significant? + JA SAVDI + SHL AL,1 ;Put sign of smaller into carry + RCR CL,1 ;Now pack it in next to sign of larger + XCHG AX,CX + MOV CL,CH + MOV CH,0 + +; Now things look like this: +; SI has pointer to smaller operand +; DI has pointer to larger operand +; AL bit 7 has sign of smaller +; AL bit 6 has sign of larger +; CL has exponent difference ( 0 <= CL <= 56 ) +; CH is zero +; AH has exponent of larger ( = tentative exponent of result) + + PUSH AX + PUSH DI ;We'll need these later + MOV DI,CX ;Need all 8-bit registers + +;Load smaller operand + + LODSB + MOV AH,AL + XOR AL,AL ;Extend operand to 64 bits with zeros + XCHG AX,DX + LODSW + XCHG AX,CX + LODSW + XCHG AX,BX + LODSW + OR AH,80H ;Set implied bit + +;Smaller operand now in AX:BX:CX:DX with implied bit set + + OR DI,DI + JZ ALIGNED ;Alignment operations necessary? +CHKALN: + CMP DI,14 ;Do shifts of 16 bits by word rotate + JL BYTSHFT ;If not enough for word, go try byte + OR DX,DX ;See if we're shifting something off the end + JZ NOSTIK + OR CL,1 ;Ensure sticky bit will be set +NOSTIK: + MOV DX,CX + MOV CX,BX + MOV BX,AX + XOR AX,AX + SUB DI,16 ;Counts for 16 bit shifts + JA CHKALN ;If not enough, try again + JZ ALIGNED ;Hit it exactly? + JB SHFLEF ;Back up if too far + +BYTSHFT: + CMP DI,6 ;Can we do a byte shift? + JL BITSHFT + OR DL,DL + JZ NSTIK + OR DH,1 +NSTIK: + MOV DL,DH + MOV DH,CL + MOV CL,CH + MOV CH,BL + MOV BL,BH + MOV BH,AL + MOV AL,AH + XOR AH,AH + SUB DI,8 + JA BITSHFT + JZ ALIGNED + +;To get here, we must have used a byte shift when we needed to shift less than +;8 bits. Now we must correct by 1 or 2 left shifts. + +SHFLEF: + SHL DX,1 + RCL CX,1 + RCL BX,1 + RCL AX,1 + INC DI + JNZ SHFLEF ;Until DI is back to zero (from -1 or -2) + JMP SHORT ALIGNED + +BITSHFT: + XCHG CX,DI + TEST DL,3FH ;See if we're shifting stuff off the end + JZ SHFRIG + OR DL,20H ;Set sticky bit if so +SHFRIG: + SHR AX,1 + RCR BX,1 + RCR DI,1 + RCR DX,1 + LOOP SHFRIG ;Do 1 to 5 64-bit right shifts + XCHG CX,DI +ALIGNED: + POP SI ;Address of larger operand + XCHG AX,DI + TEST DL,3FH ;Collapse LSBs into sticky bit + JZ GETSIGN + OR DL,20H ;Set sticky bit +GETSIGN: + POP AX ;Recover sign and exponent + SHL AL,1 ;Shift sign bits out to test + +;Now AL = sign of larger ( = tentative sign of result) +;Carry = sign of smaller. +;Overflow flag is set if these two are different. + + JO SUBMAN ;Subtract mantissas if signs are different + ADD DH,[SI] + ADC CX,[SI+1] + ADC BX,[SI+3] + PUSHF ;Save carry flag + MOV SI,[SI+5] + OR SI,8000H ;Set implied bit + POPF + ADC DI,SI + JNC ROUNDJ +;Have a carry, so result must be shifted right and exponent incremented + RCR DI,1 + RCR BX,1 + RCR CX,1 + RCR DX,1 + INC AH ;Bump exponent +ROUNDJ: JNZ ROUND + JMP $OVFL + +SUBMAN: +;Subtract mantissas since signs are different. We'll be subtracting in larger +;from smaller, so sign will be inverted first. + NOT AL + SUB DH,[SI] + SBB CX,[SI+1] + SBB BX,[SI+3] + PUSHF ;Save carry flag + MOV SI,[SI+5] + OR SI,8000H ;Set implied bit + POPF + SBB DI,SI + JNC NORM ;Won't carry if we mixed up larger and smaller +;As expected, we got a carry which means we must negate the result + XOR SI,SI ;We'll need a zero + NOT AL ;Flip sign bit + NOT DI + NOT BX + NOT CX + NEG DX ;Carry clear if zero + CMC + ADC CX,SI + ADC BX,SI + ADC DI,SI +$DNORM: +NORM: + MOV SI,4 ;Maximum of 4 word shifts +DNOR: + OR DI,DI ;See if any bits on in high word + JNZ HIBYT ;If so, go check high byte for zero + SUB AH,16 ;Drop exponent by shift count + JBE ZERO + DEC SI + JZ ZERO + MOV DI,BX + MOV BX,CX + MOV CX,DX + XOR DX,DX + JMP DNOR +HIBYT: + TEST DI,0FF00H ;See if high byte is zero + JNZ NORMSHF + SUB AH,8 ;Drop exponent by shift amount + JBE ZERO + XCHG AX,DI + MOV AH,AL + MOV AL,BH + MOV BH,BL + MOV BL,CH + MOV CH,CL + MOV CL,DH + MOV DH,DL + MOV DL,0 + OR AH,AH + XCHG AX,DI +NORMSHF: + JS ROUND ;Normalize complete? +NORMLP: + DEC AH ;Account for shift in exponent + JZ ZERO + SHL DX,1 + RCL CX,1 + RCL BX,1 + RCL DI,1 + JNO NORMLP ;Overflow will be set when sign bit changes + +$DROUND: +ROUND: + CMP DL,80H ;Check extended bits + JA ROUNDUP + JB SAVE +;Extended bits equal exactly one-half LSB, so round even + TEST DH,1 ;Already even? + JZ SAVE +ROUNDUP: + ADD DH,1 + ADC CX,0 + ADC BX,0 ;Propagate carry + ADC DI,0 + JNC SAVE ;Overflow? +;If we overflowed, DI:BX:CX:DH must now be zero, so we can leave it that way. + INC AH ;Increment exponent + JZ OVERFLOW +SAVE: + AND AL,80H ;Strip to sign bit + XCHG BX,DI + AND BH,7FH ;Mask off implied bit + OR AL,BH ;Combine sign with mantissa + MOV [$DAC+6],AX + MOV [$FAC-2],BL + MOV BX,DI + MOV DI,OFFSET DC:$DAC + MOV AL,DH + STOSB + XCHG AX,CX + STOSW + XCHG AX,BX + STOSW + RET + +OVCHK: + JNS ZERO +OVERFLOW: + JMP $OVFL + +ZERO: + MOV [$FAC],0 + RET + + +$FMUD: + MOV SI,OFFSET DC:$DAC + JMP SHORT $FMUB +$FMUH: + CALL $GTMP +$FMUF: + MOV DI,OFFSET DC:$DAC +$FMUB: + CALL $SAVREG + + SUBTTL $DMUL - Double precision multiply +; Inputs: +; SI = Address of one operand +; DI = Address of other operand +; Function: +; Multiply with result in FAC. +; Outputs: +; Result in FAC. +; Registers: +; Uses ALL. + +$DMUL: + MOV AX,[SI+6] ;High part of op1 + OR AH,AH + JZ ZERO + MOV CX,[DI+6] ;High part of op2 + OR CH,CH + JZ ZERO + XOR AL,CL ;Compute sign + +;Exponent computation. +;Compute sum of exponents minus one. The minus one is valid if the product +;will need normalization by one bit. If it doesn't, one will be added to the +;exponent. A zero exponent will temporarily be OK because of this possibility +;of adding one later. + + SUB AH,128+1 ;Subtract bias and extra "minus one" + SUB CH,128 + ADD AH,CH ;Add exponents +OVCHKJ: JO OVCHK ;If overflow, check whether up or down + ADD AH,128 ;Put bias back in + PUSH AX ;Save sign and tentative exponent + CALL PMULD ;Multiply mantissas + JZ NORMCHK ;Need to set sticky bit? + OR DL,1 +NORMCHK: + POP AX ;Get exp. and sign back + OR DI,DI ;See if normalized + JS INCEXP ;Yes - increment exponent + SHL DX,1 ;Normalize + RCL CX,1 + RCL BX,1 + RCL DI,1 + OR AH,AH ;Is exponent zero? + JNZ RNDJMP + JMP ZERO + +INCEXP: + INC AH + JZ OVERFLOW +RNDJMP: JMP ROUND + + +$FDVD: + MOV SI,OFFSET DC:$DAC + JMP SHORT $FDVB +$FDVH: + CALL $GTMP +$FDVF: + MOV DI,OFFSET DC:$DAC +$FDVB: + CALL $SAVREG + + SUBTTL $DDIV - Double precision divide +; Inputs: +; SI = Address of Dividend (Numerator) +; DI = Address of Divisor (Denominator) +; Function: +; Compute [SI] / [DI] +; Outputs: +; Result in FAC. +; Registers: +; All destroyed. + +$DDIV: + MOV AX,[SI+6] ;High half of numerator + MOV CX,[DI+6] ;High half of denominator + XOR AL,CL ;Compute sign + OR CH,CH ;Denominator zero? + JZ DIV0 + OR AH,AH ;Numerator zero? + JZ ZERO + SUB AH,128 ;Remove bias from exponents + SUB CH,128 + SUB AH,CH ;Compute result exponent + JO OVCHKJ + +;AH has the (tentative) true exponent of the result. It is correct if the +;result needs normalizing one bit. If not, 1 will be added to it. A true +;exponent of -128, not normally allowed except to represent zero, is OK +;here because of this possible future incrementing. + + ADD AH,128 ;Put bias back + PUSH AX ;Save sign and exponent + LODSB ;Load up dividend + MOV CH,AL + XOR CL,CL + LODSW + XCHG AX,BX + LODSW + XCHG AX,DX + LODSW + OR AH,80H ;Set implied bit + XCHG AX,DX ;Divisor in DX:AX:BX:CX + +;Move divisor to FAC so we can get at it easily. More importantly, get it in +;the necessary form - extended to 64 bits with zeros, implied bit set. +;The form we want it in will have the mantissa MSB where the exponent usually +;is, so by moving high to low we will not destroy the divisor even if it is +;already in the FAC. + + MOV SI,DI + ADD SI,5 ;Point to high end of divisor + MOV DI,OFFSET DC:$FAC-1 + STD ;Direction DOWN + MOVSW ;Move divisor to FAC + MOVSW + MOVSW + INC SI + INC DI + MOVSB + CLD ;Restore direction + MOV BYTE PTR[DI],0 ;Extend to 64 bits with a zero + OR [$FAC],80H ;Set implied bit + +;Now we're all set: +; DX:AX:BX:CX has dividend +; FAC has divisor (not in normal format) +;Both are extended to 64 bits with zeros and have implied bit set. +;Top of stack has sign and tentative exponent. + + SHR DX,1 ;Make sure dividend is smaller than divisor + RCR AX,1 ; by dividing it by two + RCR BX,1 + RCR CX,1 + CALL DIV16 ;Get a quotient digit + PUSH DI + CALL DIV16 + PUSH DI + CALL DIV16 + PUSH DI + CALL DIV16 + OR AX,BX ;Remainder zero? + OR AX,CX + OR AX,DX + MOV DX,DI ;Get lowest word in position + JZ NSTK1 + OR DL,1 ;Set sticky bit if not +NSTK1: + POP CX ;Recover quotient digits + POP BX + POP DI + JMP NORMCHK + +DIV0: JMP $DIV0 + +DIV16: + MOV SI,[$DAC+6] ;Get high word of divisor + XOR DI,DI ;Initialize quotient digit to zero + CMP DX,SI ;Will we overflow? + JAE MAXQUO ;If so, go handle special + OR DX,DX ;Is dividend small? + JNZ DODIV + CMP SI,AX ;Will divisor fit at all? + JA ZERQUO ;No - quotient is zero +DODIV: + DIV SI ;AX is our digit "guess" + PUSH DX ;Save remainder + XCHG AX,DI ;Quotient digit in DI + XOR BP,BP ;Initialize quotient * divisor + MOV SI,BP + MOV AX,[$DAC] + OR AX,AX ;If zero, save multiply time + JZ REM2 + MUL DI ;Begin computing quotient * divisor + MOV SI,DX +REM2: + PUSH AX ;Save lowest word of quotient * divisor + MOV AX,[$DAC+2] + OR AX,AX + JZ REM3 + MUL DI + ADD SI,AX + ADC BP,DX +REM3: + MOV AX,[$DAC+4] + OR AX,AX + JZ REM4 + MUL DI + ADD BP,AX + ADC DX,0 + XCHG AX,DX +REM4: ;Quotient * divisor in AX:BP:SI:[SP] + POP DX ;Recover lowest word of quotient * divisor + NEG DX ;Subtract from dividend + SBB CX,SI + SBB BX,BP + POP BP ;Remainder from DIV + SBB BP,AX + XCHG AX,BP +ZERQUO: ;Remainder in AX:BX:CX:DX + XCHG AX,DX + XCHG AX,CX + XCHG AX,BX + JNC RET ;Remainder in DX:AX:BX:CX +RESTORE: + DEC DI ;Drop quotient since it didn't fit + ADD CX,[$DAC] ;Add divisor back in until remainder goes + + ADC BX,[$DAC+2] + ADC AX,[$DAC+4] + ADC DX,[$DAC+6] + JNC RESTORE +RET: RET + +MAXQUO: + DEC DI ;DI=FFFF=2**16-1 + SUB CX,[$DAC] + SBB BX,[$DAC+2] + SBB AX,[$DAC+4] + ADD CX,[$DAC+2] + ADC BX,[$DAC+4] + ADC AX,DX + MOV DX,[$DAC] + CMC + JMP ZERQUO + + + SUBTTL PMULD - Partial DP multiply + +; Inputs: +; SI = Address of multiplicand +; DI = Address of multiplier +; Function: +; Multiply mantissas and provide unrounded 64 bit result. +; Outputs: +; Result in DI:BX:CX:DX. +; SI is non-zero (flags set accordingly) if not exact result +; Registers: +; Uses ALL. + +PMULD: + MOV AL,[SI+6] ;Get most significant mantissa byte + MOV AH,0 ;Extend with a zero + OR AL,80H ;Set implied bit + MOV [OP1MAN],AX ;Save for easy access + MOV AL,[DI+6] + MOV AH,0 + OR AL,80H + MOV [OP2MAN],AX ;Second operand similarly prepared + +; Perform multiply by summing partial products of 16x16 hardware multiply. +; Before each multiply, the operands are checked for zero to see if it can be +; skipped, since it's a slow operation on the 8086. The sum is kept in +; registers as much as possible. Any insignificant bits lost are ORed together +; and kept in a word on the top of the stack. This can be used for sticky bit +; rounding. + + XOR BX,BX + MOV BP,BX + MOV CX,[SI] + JCXZ PROD3 ;Skip 2 multiplies if zero + XCHG AX,CX + MOV CX,[DI] + JCXZ PROD2 + MUL CX + MOV BP,AX ;Save insignificant bits + MOV CX,DX + MOV AX,[SI] +PROD2: ;Partial result in CX + MOV DX,[DI+2] + OR DX,DX + JZ PROD3 + MUL DX + ADD CX,AX + ADC BX,DX +PROD3: ;Partial result in BX:CX + PUSH BP ;Save insignificant bits on stack + XOR BP,BP + MOV AX,[SI+2] + OR AX,AX + JZ PROD4 + MOV DX,[DI] + OR DX,DX + JZ PROD4 + MUL DX + ADD CX,AX + ADC BX,DX + RCL BP,1 ;Pick up carry +PROD4: ;Partial result in BP:BX:CX + POP AX + OR AX,CX ;Record these bits before we throw them away + PUSH AX + MOV AX,[SI+2] + OR AX,AX + JZ PROD5 + MOV DX,[DI+2] + OR DX,DX + JZ PROD5 + MUL DX + ADD BX,AX + ADC BP,DX +PROD5: ;Partial result in BP:BX + XOR CX,CX + MOV AX,[SI] + OR AX,AX + JZ PROD6 + MOV DX,[DI+4] + OR DX,DX + JZ PROD6 + MUL DX + ADD BX,AX + ADC BP,DX + RCL CX,1 +PROD6: ;Partial result in CX:BP:BX + MOV AX,[SI+4] + OR AX,AX + JZ PROD7 + MOV DX,[DI] + OR DX,DX + JZ PROD7 + MUL DX + ADD BX,AX + ADC BP,DX + ADC CX,0 +PROD7: ;Partial result in CX:BP:BX + POP AX + OR AX,BX + PUSH AX + MOV AX,[SI] + OR AX,AX + JZ PROD8 + MUL [OP2MAN] + ADD BP,AX + ADC CX,DX +PROD8: ;Partial result in CX:BP + MOV AX,[DI] + OR AX,AX + JZ PROD9 + MUL [OP1MAN] + ADD BP,AX + ADC CX,DX +PROD9: ;Partial result in CX:BP + XOR BX,BX + MOV AX,[SI+2] + OR AX,AX + JZ PROD10 + MOV DX,[DI+4] + OR DX,DX + JZ PROD10 + MUL DX + ADD BP,AX + ADC CX,DX + RCL BX,1 +PROD10: ;Partial result in BX:CX:BP + MOV AX,[SI+4] + OR AX,AX + JZ PROD11 + MOV DX,[DI+2] + OR DX,DX + JZ PROD11 + MUL DX + ADD BP,AX + ADC CX,DX + ADC BX,0 +PROD11: ;Partial result in BX:CX:BP + PUSH BP ;Not enough registers to keep LSW + XOR BP,BP + MOV AX,[DI+2] + OR AX,AX + JZ PROD12 + MUL [OP1MAN] + ADD CX,AX + ADC BX,DX +PROD12: ;Partial result in BP:BX:CX + MOV AX,[SI+2] + OR AX,AX + JZ PROD13 + MUL [OP2MAN] + ADD CX,AX + ADC BX,DX +PROD13: ;Partial result in BP:BX:CX + MOV AX,[SI+4] + OR AX,AX + JZ PROD15 + MOV DX,[DI+4] + OR DX,DX + JZ PROD14 + MUL DX + ADD CX,AX + ADC BX,DX + RCL BP,1 + MOV AX,[SI+4] +PROD14: ;Partial result in BP:BX:CX + MUL [OP2MAN] + ADD BX,AX + ADC BP,DX +PROD15: ;Partial result in BP:BX:CX + MOV AX,[DI+4] + OR AX,AX + JZ PROD16 + MUL [OP1MAN] + ADD BX,AX + ADC BP,DX +PROD16: ;Partial result in BP:BX:CX + MOV AL,BYTE PTR[OP1MAN] + MUL BYTE PTR[OP2MAN] + ADD AX,BP + XCHG AX,DI + POP DX ;Get least significant bits + POP SI ;Get trimmed bits + OR SI,SI ;Set flags + RET + +CODE ENDS + END From 099a01fc651154a165602d1eb86f8caf0f5cf285 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sun, 21 Jun 2026 17:42:18 -0700 Subject: [PATCH 13/53] Transcription of Bundle 9 - DOSDAT.ASM Code and Listing Created file MSDOS.INC from listing, required for build. (See line 5 for include statement, lines 6-29 for content) --- 2_printed_files/bundle_09/DOSDAT.ASM | 540 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DOSDAT.ASM | 267 +++++++++++++ 3_source_code/BASLIB-86/MSDOS.INC | 24 ++ 3 files changed, 831 insertions(+) create mode 100644 2_printed_files/bundle_09/DOSDAT.ASM create mode 100644 3_source_code/BASLIB-86/DOSDAT.ASM create mode 100644 3_source_code/BASLIB-86/MSDOS.INC diff --git a/2_printed_files/bundle_09/DOSDAT.ASM b/2_printed_files/bundle_09/DOSDAT.ASM new file mode 100644 index 0000000..997a519 --- /dev/null +++ b/2_printed_files/bundle_09/DOSDAT.ASM @@ -0,0 +1,540 @@ +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 1-1 + + + + 1 TITLE DOSDAT - MS-DOS DATE$ and TIME$ Support + 2 + 3 .SALL + 4 + 5 C INCLUDE MSDOS.INC + 6 C 00100 ; MSDOS.INC - MS-DOS I/O Macro defns. + 7 C 00200 + 8 C 00300 ; VECTOR INTERRUPT EQUATES + 9 C 00400 + 10 = 0021 C 00500 I_DOSIO= 21H ;MSDOS_IO + 11 C 00600 + 12 C 00700 + 13 C 00800 ; MS-DOS INTERRUPT CALL MACRO DEFNS + 14 C 00900 + 15 C 01000 DOSMAC MACRO NAM + 16 C 01100 NAM MACRO FUNC + 17 C 01200 IFNB + 18 C 01300 MOV AH,FUNC + 19 C 01400 ENDIF + 20 C 01500 INT I_&NAM + 21 C 01600 ENDM + 22 C 01700 ENDM + 23 C 01800 + 24 C 01900 + 25 C 02000 DOSMAC DOSIO ;;MSDOS_IO + 26 C 02100 + 27 C 02200 + 28 = C 02300 ENABLE EQU STI ;Enable Interrupts + 29 = C 02400 DISABLE EQU CLI ;Disable Interrupts + 30 + 31 + 32 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 33 + 34 EXTRN $$SPSV:WORD + 35 + 36 0000 DATA ENDS + 37 + 38 DC GROUP DATA + 39 + 40 + 41 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 42 + 43 PUBLIC $DAT, $DAF ;DATE$ + 44 PUBLIC $TIM, $TIF ;TIME$ + 45 + 46 EXTRN $$ATS:NEAR, $$DITS:NEAR + 47 EXTRN $ERC_FC:NEAR + 48 + 49 ASSUME CS:CODE, DS:DC, ES:DC + 50 + 51 = 002A GETDAT= 42 ;Get Date Function + 52 = 002B SETDAT= 43 ;Set Date Function + 53 = 002C GETTIM= 44 ;Get Time Function + 54 = 002D SETTIM= 45 ;Set Time Function + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 1-2 + + + + 55 + 56 + 57 SUBTTL $DAT - Set Date. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 2-1 +$DAT - Set Date. + + + 58 + 59 ;$DAT - Set Date. + 60 + 61 0000 DOSDAT PROC FAR + 62 + 63 0000 $DAT: + 64 0000 89 26 0000 E MOV [$$SPSV],SP + 65 0004 50 PUSH AX + 66 0005 51 PUSH CX + 67 0006 52 PUSH DX + 68 0007 56 PUSH SI + 69 0008 53 PUSH BX + 70 0009 8B 77 02 MOV SI,[BX+2] ;[SI] has addr of string. + 71 000C 8B 1F MOV BX,[BX] ;[BX] has string length + 72 000E 0B DB OR BX,BX ;String must not be null + 73 0010 74 7D JZ DATE_ERROR ;Brif null str + 74 0012 E8 013B R CALL GETNUM ;Get 1 or 2 digit number + 75 0015 8A F4 MOV DH,AH ;[DH] = month + 76 0017 E8 011B R CALL DATSEP + 77 001A E8 013B R CALL GETNUM + 78 001D 8A D4 MOV DL,AH ;[DL] = day + 79 001F E8 011B R CALL DATSEP + 80 0022 E8 013B R CALL GETNUM + 81 0025 B9 076C MOV CX,1900 ;Bias in case only 2-digit year + 82 0028 0B DB OR BX,BX ;End-of-string? + 83 002A 74 09 JZ DATE2 ;Brif so. + 84 002C B0 64 MOV AL,100 + 85 002E F6 E4 MUL AH ;Mult decade by 100 + 86 0030 8B C8 MOV CX,AX ;Save bias for year add + 87 0032 E8 013B R CALL GETNUM ;Get year (digits 3 & 4). + 88 0035 DATE2: + 89 0035 8A C4 MOV AL,AH + 90 0037 B4 00 MOV AH,0 + 91 0039 03 C8 ADD CX,AX ;Add 2 digits of base to century + 92 DOSIO SETDAT ;Give date to DOS. + 93 003F $TIM_RET: + 94 003F 0A C0 OR AL,AL ;Date (or Time) OK? + 95 0041 75 4C JNZ DATE_ERROR ;Brif not. + 96 0043 5B POP BX + 97 0044 E8 0000 E CALL $$DITS ;Delete the Temp + 98 0047 53 PUSH BX + 99 0048 $DAF_RET: + 100 0048 5B POP BX + 101 0049 5E POP SI + 102 004A 5A POP DX + 103 004B 59 POP CX + 104 004C 58 POP AX + 105 004D CB RET ;Exit. + 106 004E DOSDAT ENDP + 107 + 108 + 109 SUBTTL $DAF - Get Date. + + + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 3-1 +$DAF - Get Date. + + + 110 + 111 ;$DAF - Get Date. + 112 + 113 004E $DAF: + 114 004E 50 PUSH AX + 115 004F 51 PUSH CX + 116 0050 52 PUSH DX + 117 0051 56 PUSH SI + 118 0052 BB 000A MOV BX,10 + 119 0055 E8 0000 E CALL $$ATS ;Get space for 10 char string + 120 0058 53 PUSH BX ;Save String Descriptor + 121 0059 52 PUSH DX ;Save addr of string + 122 DOSIO GETDAT ;Get Date from DOS + 123 005E 5B POP BX ;Restore addr of String + 124 005F 8A C6 MOV AL,DH + 125 0061 E8 0160 R CALL PUTCHR ;Store ascii month + 126 0064 B0 2D MOV AL,"-" + 127 0066 E8 016C R CALL PUTCH2 + 128 0069 8A C2 MOV AL,DL + 129 006B E8 0160 R CALL PUTCHR ;Store ascii day + 130 006E B0 2D MOV AL,"-" + 131 0070 E8 016C R CALL PUTCH2 + 132 0073 81 E9 076C SUB CX,1900 ;Reduce year by two digits + 133 0077 80 F9 64 CMP CL,100 ;See if in 20th century + 134 007A B5 13 MOV CH,19 ;Setup 20th century in case + 135 007C 72 05 JB DATEF2 ;Brif so. + 136 007E 80 D9 64 SBB CL,100 ;subtract into next century + 137 0081 FE C5 INC CH ;21st century + 138 0083 DATEF2: + 139 0083 8A C5 MOV AL,CH + 140 0085 E8 0160 R CALL PUTCHR ;Store ascii century + 141 0088 8A C1 MOV AL,CL + 142 008A E8 0160 R CALL PUTCHR ;Store ascii year. + 143 + 144 008D EB B9 JMP $DAF_RET ;Return Date String (Desc on stack). + 145 + 146 008F DATE_ERROR: + 147 008F E9 0000 E JMP $ERC_FC ;Complain + 148 + 149 + 150 SUBTTL $TIM - Set Time. + + + + + + + + + + + + + + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 4-1 +$TIM - Set Time. + + + 151 + 152 ;$TIM - Set Time. + 153 + 154 0092 $TIM: + 155 0092 89 26 0000 E MOV [$$SPSV],SP + 156 0096 50 PUSH AX + 157 0097 51 PUSH CX + 158 0098 52 PUSH DX + 159 0099 56 PUSH SI + 160 009A 53 PUSH BX + 161 009B 8B 77 02 MOV SI,[BX+2] ;[SI] has addr of string. + 162 009E 8B 1F MOV BX,[BX] ;[BX] has string length + 163 00A0 0B DB OR BX,BX ;String must not be null + 164 00A2 74 74 JZ TIME_ERROR ;Brif null str + 165 00A4 E8 013B R CALL GETNUM ;Get 1 or 2 digit number + 166 00A7 8A EC MOV CH,AH ;[CH] = hours + 167 00A9 E8 012B R CALL TIMSEP + 168 00AC E8 013B R CALL GETNUM + 169 00AF 8A CC MOV CL,AH ;[CL] = minutes + 170 00B1 E8 012B R CALL TIMSEP + 171 00B4 E8 013B R CALL GETNUM + 172 00B7 8A F4 MOV DH,AH ;[DH] = seconds + 173 00B9 E8 012B R CALL TIMSEP + 174 00BC E8 013B R CALL GETNUM + 175 00BF 8A D4 MOV DL,AH ;[DL] = 100ths. + 176 DOSIO SETTIM ;Give Time to DOS. + 177 00C5 E9 003F R JMP $TIM_RET ;Check Time OK & Exit. + 178 + 179 + 180 SUBTTL $TIF - Get Time. + + + + + + + + + + + + + + + + + + + + + + + + + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 5-1 +$TIF - Get Time. + + + 181 + 182 ;$TIF - Get Time. + 183 + 184 00C8 $TIF: + 185 00C8 50 PUSH AX + 186 00C9 51 PUSH CX + 187 00CA 52 PUSH DX + 188 00CB 56 PUSH SI + 189 00CC BB 000B MOV BX,11 + 190 00CF E8 0000 E CALL $$ATS ;Get space for 11 char string + 191 00D2 53 PUSH BX ;Save String Descriptor + 192 00D3 52 PUSH DX ;Save addr of string + 193 DOSIO GETTIM ;Get Time from DOS + 194 00D8 80 FA 32 CMP DL,50 + 195 00DB 72 14 JB TIMEF2 ;Brif .lt. 1/2 sec + 196 00DD FE C6 INC DH ;Bump secs. + 197 00DF 80 FE 3C CMP DH,60 + 198 00E2 72 0D JB TIMEF2 ;Brif no ovf + 199 00E4 B6 00 MOV DH,0 + 200 00E6 FE C1 INC CL ;Bump mins. + 201 00E8 80 F9 3C CMP CL,60 + 202 00EB 72 04 JB TIMEF2 ;Brif no ovf + 203 00ED B1 00 MOV CL,0 + 204 00EF FE C5 INC CH ;Bump hrs. + 205 00F1 TIMEF2: + 206 00F1 5B POP BX ;Restore addr of String + 207 00F2 8A C5 MOV AL,CH + 208 00F4 E8 0160 R CALL PUTCHR ;Store ascii hours + 209 00F7 B0 3A MOV AL,":" + 210 00F9 E8 016C R CALL PUTCH2 + 211 00FC 8A C1 MOV AL,CL + 212 00FE E8 0160 R CALL PUTCHR ;Store ascii minutes + 213 0101 B0 3A MOV AL,":" + 214 0103 E8 016C R CALL PUTCH2 + 215 0106 8A C6 MOV AL,DH + 216 0108 E8 0160 R CALL PUTCHR ;Store ascii seconds. + 217 010B B0 2E MOV AL,"." + 218 010D E8 016C R CALL PUTCH2 + 219 0110 8A C2 MOV AL,DL + 220 0112 E8 0160 R CALL PUTCHR ;Store ascii 100ths. + 221 + 222 0115 E9 0048 R JMP $DAF_RET ;Return Time String (Desc on stack). + 223 + 224 0118 TIME_ERROR: + 225 0118 E9 008F R JMP DATE_ERROR ;Complain + 226 + 227 + 228 SUBTTL $DATE and $TIME Utility Subroutines + + + + + + + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 6-1 +$DATE and $TIME Utility Subroutines + + + 229 + 230 011B DATSEP: + 231 011B 0B DB OR BX,BX + 232 011D 74 F9 JZ TIME_ERROR ;Error if string empty. + 233 011F 4B DEC BX ;Length -1 + 234 0120 AC LODSB + 235 0121 3C 2F CMP AL,"/" + 236 0123 74 26 JZ GETNUX + 237 0125 3C 2D CMP AL,"-" + 238 0127 74 22 JZ GETNUX + 239 0129 EB ED JMP TIME_ERROR + 240 + 241 + 242 012B TIMSEP: + 243 012B 0B DB OR BX,BX + 244 012D 74 1C JZ GETNUX + 245 012F 4B DEC BX + 246 0130 AC LODSB + 247 0131 3C 3A CMP AL,":" + 248 0133 74 16 JZ GETNUX + 249 0135 3C 2E CMP AL,"." + 250 0137 74 12 JZ GETNUX + 251 0139 EB DD JMP TIME_ERROR + 252 + 253 013B GETNUM: + 254 013B E8 014C R CALL DIGIT + 255 013E 72 D8 JB TIME_ERROR + 256 0140 8A E0 MOV AH,AL + 257 0142 E8 014C R CALL DIGIT + 258 0145 72 04 JB GETNUX + 259 0147 D5 0A AAD ;Convert BCD to Binary + 260 0149 8A E0 MOV AH,AL + 261 014B GETNUX: + 262 014B C3 RET + 263 014C DIGIT: + 264 014C 8A C3 MOV AL,BL ;Init to 0 if string exhausted + 265 014E 0B DB OR BX,BX ;End-of-string? + 266 0150 74 F9 JZ GETNUX ;Brif so, returns 0 + 267 0152 8A 04 MOV AL,[SI] + 268 0154 1C 30 SBB AL,"0" + 269 0156 72 F3 JB GETNUX + 270 0158 3C 0A CMP AL,10 + 271 015A F5 CMC + 272 015B 72 EE JB GETNUX + 273 015D 4B DEC BX ;Length -1 + 274 015E 46 INC SI + 275 015F C3 RET + 276 + 277 + 278 0160 PUTCHR: + 279 0160 D4 0A AAM ;Convert to unpacked BCD + 280 0162 86 C4 XCHG AL,AH + 281 0164 0D 3030 OR AX,"00" ;Add "0" bias to both digits. + 282 0167 E8 016C R CALL PUTCH2 + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Page 6-2 +$DATE and $TIME Utility Subroutines + + + 283 016A 8A C4 MOV AL,AH + 284 016C PUTCH2: + 285 016C 88 07 MOV [BX],AL ;store char in string + 286 016E 43 INC BX + 287 016F C3 RET + 288 + 289 + 290 0170 CODE ENDS + 291 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DOSDAT - MS-DOS DATE$ and TIME$ Support Macro-86 %1(12) 1:0:16 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DOSIO. . . . . . . . . . . . . . 0002 +DOSMAC . . . . . . . . . . . . . 0002 + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0170 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +DATE2. . . . . . . . . . . . . . L NEAR 0035 CODE +DATEF2 . . . . . . . . . . . . . L NEAR 0083 CODE +DATE_ERROR . . . . . . . . . . . L NEAR 008F CODE +DATSEP . . . . . . . . . . . . . L NEAR 011B CODE +DIGIT. . . . . . . . . . . . . . L NEAR 014C CODE +DISABLE. . . . . . . . . . . . . Opcode +DOSDAT . . . . . . . . . . . . . F PROC 0000 CODE Length =004E +ENABLE . . . . . . . . . . . . . Opcode +GETDAT . . . . . . . . . . . . . Number 002A +GETNUM . . . . . . . . . . . . . L NEAR 013B CODE +GETNUX . . . . . . . . . . . . . L NEAR 014B CODE +GETTIM . . . . . . . . . . . . . Number 002C +I_DOSIO. . . . . . . . . . . . . Number 0021 +PUTCH2 . . . . . . . . . . . . . L NEAR 016C CODE +PUTCHR . . . . . . . . . . . . . L NEAR 0160 CODE +SETDAT . . . . . . . . . . . . . Number 002B +SETTIM . . . . . . . . . . . . . Number 002D +TIMEF2 . . . . . . . . . . . . . L NEAR 00F1 CODE +TIME_ERROR . . . . . . . . . . . L NEAR 0118 CODE +TIMSEP . . . . . . . . . . . . . L NEAR 012B CODE +$$ATS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$DAF . . . . . . . . . . . . . . L NEAR 004E CODE Global +$DAF_RET . . . . . . . . . . . . L NEAR 0048 CODE +$DAT . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$TIF . . . . . . . . . . . . . . L NEAR 00C8 CODE Global +$TIM . . . . . . . . . . . . . . L NEAR 0092 CODE Global +$TIM_RET . . . . . . . . . . . . L NEAR 003F CODE + +Warning Severe +Errors Errors +0 0 + + + diff --git a/3_source_code/BASLIB-86/DOSDAT.ASM b/3_source_code/BASLIB-86/DOSDAT.ASM new file mode 100644 index 0000000..c048e93 --- /dev/null +++ b/3_source_code/BASLIB-86/DOSDAT.ASM @@ -0,0 +1,267 @@ + TITLE DOSDAT - MS-DOS DATE$ and TIME$ Support + + .SALL + + INCLUDE MSDOS.INC + + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$SPSV:WORD + +DATA ENDS + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $DAT, $DAF ;DATE$ + PUBLIC $TIM, $TIF ;TIME$ + + EXTRN $$ATS:NEAR, $$DITS:NEAR + EXTRN $ERC_FC:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +GETDAT= 42 ;Get Date Function +SETDAT= 43 ;Set Date Function +GETTIM= 44 ;Get Time Function +SETTIM= 45 ;Set Time Function + + + SUBTTL $DAT - Set Date. + +;$DAT - Set Date. + +DOSDAT PROC FAR + +$DAT: + MOV [$$SPSV],SP + PUSH AX + PUSH CX + PUSH DX + PUSH SI + PUSH BX + MOV SI,[BX+2] ;[SI] has addr of string. + MOV BX,[BX] ;[BX] has string length + OR BX,BX ;String must not be null + JZ DATE_ERROR ;Brif null str + CALL GETNUM ;Get 1 or 2 digit number + MOV DH,AH ;[DH] = month + CALL DATSEP + CALL GETNUM + MOV DL,AH ;[DL] = day + CALL DATSEP + CALL GETNUM + MOV CX,1900 ;Bias in case only 2-digit year + OR BX,BX ;End-of-string? + JZ DATE2 ;Brif so. + MOV AL,100 + MUL AH ;Mult decade by 100 + MOV CX,AX ;Save bias for year add + CALL GETNUM ;Get year (digits 3 & 4). +DATE2: + MOV AL,AH + MOV AH,0 + ADD CX,AX ;Add 2 digits of base to century + DOSIO SETDAT ;Give date to DOS. +$TIM_RET: + OR AL,AL ;Date (or Time) OK? + JNZ DATE_ERROR ;Brif not. + POP BX + CALL $$DITS ;Delete the Temp + PUSH BX +$DAF_RET: + POP BX + POP SI + POP DX + POP CX + POP AX + RET ;Exit. +DOSDAT ENDP + + + SUBTTL $DAF - Get Date. + +;$DAF - Get Date. + +$DAF: + PUSH AX + PUSH CX + PUSH DX + PUSH SI + MOV BX,10 + CALL $$ATS ;Get space for 10 char string + PUSH BX ;Save String Descriptor + PUSH DX ;Save addr of string + DOSIO GETDAT ;Get Date from DOS + POP BX ;Restore addr of String + MOV AL,DH + CALL PUTCHR ;Store ascii month + MOV AL,"-" + CALL PUTCH2 + MOV AL,DL + CALL PUTCHR ;Store ascii day + MOV AL,"-" + CALL PUTCH2 + SUB CX,1900 ;Reduce year by two digits + CMP CL,100 ;See if in 20th century + MOV CH,19 ;Setup 20th century in case + JB DATEF2 ;Brif so. + SBB CL,100 ;subtract into next century + INC CH ;21st century +DATEF2: + MOV AL,CH + CALL PUTCHR ;Store ascii century + MOV AL,CL + CALL PUTCHR ;Store ascii year. + + JMP $DAF_RET ;Return Date String (Desc on stack). + +DATE_ERROR: + JMP $ERC_FC ;Complain + + + SUBTTL $TIM - Set Time. + +;$TIM - Set Time. + +$TIM: + MOV [$$SPSV],SP + PUSH AX + PUSH CX + PUSH DX + PUSH SI + PUSH BX + MOV SI,[BX+2] ;[SI] has addr of string. + MOV BX,[BX] ;[BX] has string length + OR BX,BX ;String must not be null + JZ TIME_ERROR ;Brif null str + CALL GETNUM ;Get 1 or 2 digit number + MOV CH,AH ;[CH] = hours + CALL TIMSEP + CALL GETNUM + MOV CL,AH ;[CL] = minutes + CALL TIMSEP + CALL GETNUM + MOV DH,AH ;[DH] = seconds + CALL TIMSEP + CALL GETNUM + MOV DL,AH ;[DL] = 100ths. + DOSIO SETTIM ;Give Time to DOS. + JMP $TIM_RET ;Check Time OK & Exit. + + + SUBTTL $TIF - Get Time. + +;$TIF - Get Time. + +$TIF: + PUSH AX + PUSH CX + PUSH DX + PUSH SI + MOV BX,11 + CALL $$ATS ;Get space for 11 char string + PUSH BX ;Save String Descriptor + PUSH DX ;Save addr of string + DOSIO GETTIM ;Get Time from DOS + CMP DL,50 + JB TIMEF2 ;Brif .lt. 1/2 sec + INC DH ;Bump secs. + CMP DH,60 + JB TIMEF2 ;Brif no ovf + MOV DH,0 + INC CL ;Bump mins. + CMP CL,60 + JB TIMEF2 ;Brif no ovf + MOV CL,0 + INC CH ;Bump hrs. +TIMEF2: + POP BX ;Restore addr of String + MOV AL,CH + CALL PUTCHR ;Store ascii hours + MOV AL,":" + CALL PUTCH2 + MOV AL,CL + CALL PUTCHR ;Store ascii minutes + MOV AL,":" + CALL PUTCH2 + MOV AL,DH + CALL PUTCHR ;Store ascii seconds. + MOV AL,"." + CALL PUTCH2 + MOV AL,DL + CALL PUTCHR ;Store ascii 100ths. + + JMP $DAF_RET ;Return Time String (Desc on stack). + +TIME_ERROR: + JMP DATE_ERROR ;Complain + + + SUBTTL $DATE and $TIME Utility Subroutines + +DATSEP: + OR BX,BX + JZ TIME_ERROR ;Error if string empty. + DEC BX ;Length -1 + LODSB + CMP AL,"/" + JZ GETNUX + CMP AL,"-" + JZ GETNUX + JMP TIME_ERROR + + +TIMSEP: + OR BX,BX + JZ GETNUX + DEC BX + LODSB + CMP AL,":" + JZ GETNUX + CMP AL,"." + JZ GETNUX + JMP TIME_ERROR + +GETNUM: + CALL DIGIT + JB TIME_ERROR + MOV AH,AL + CALL DIGIT + JB GETNUX + AAD ;Convert BCD to Binary + MOV AH,AL +GETNUX: + RET +DIGIT: + MOV AL,BL ;Init to 0 if string exhausted + OR BX,BX ;End-of-string? + JZ GETNUX ;Brif so, returns 0 + MOV AL,[SI] + SBB AL,"0" + JB GETNUX + CMP AL,10 + CMC + JB GETNUX + DEC BX ;Length -1 + INC SI + RET + + +PUTCHR: + AAM ;Convert to unpacked BCD + XCHG AL,AH + OR AX,"00" ;Add "0" bias to both digits. + CALL PUTCH2 + MOV AL,AH +PUTCH2: + MOV [BX],AL ;store char in string + INC BX + RET + + +CODE ENDS + END diff --git a/3_source_code/BASLIB-86/MSDOS.INC b/3_source_code/BASLIB-86/MSDOS.INC new file mode 100644 index 0000000..6db7ef0 --- /dev/null +++ b/3_source_code/BASLIB-86/MSDOS.INC @@ -0,0 +1,24 @@ +; MSDOS.INC - MS-DOS I/O Macro defns. + +; VECTOR INTERRUPT EQUATES + +I_DOSIO= 21H ;MSDOS_IO + + +; MS-DOS INTERRUPT CALL MACRO DEFNS + +DOSMAC MACRO NAM +NAM MACRO FUNC +IFNB + MOV AH,FUNC +ENDIF + INT I_&NAM + ENDM + ENDM + + + DOSMAC DOSIO ;;MSDOS_IO + + +ENABLE EQU STI ;Enable Interrupts +DISABLE EQU CLI ;Disable Interrupts From 843eaa67cdb0cee13b4d6cabd391a5691aa43429 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sun, 21 Jun 2026 19:35:47 -0700 Subject: [PATCH 14/53] Transcription of Bundle 9 - DOSIO.ASM Code and Listing Created file INTMAC.INC from listing, required for build. (See line 5 for include statement, lines 6-47 for content) NOTE there are several extra records in the symbol table that are not in the source code for the listing. --- 2_printed_files/bundle_09/DOSIO.ASM | 660 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DOSIO.ASM | 249 +++++++++++ 3_source_code/BASLIB-86/INTMAC.INC | 42 ++ 3 files changed, 951 insertions(+) create mode 100644 2_printed_files/bundle_09/DOSIO.ASM create mode 100644 3_source_code/BASLIB-86/DOSIO.ASM create mode 100644 3_source_code/BASLIB-86/INTMAC.INC diff --git a/2_printed_files/bundle_09/DOSIO.ASM b/2_printed_files/bundle_09/DOSIO.ASM new file mode 100644 index 0000000..89cf986 --- /dev/null +++ b/2_printed_files/bundle_09/DOSIO.ASM @@ -0,0 +1,660 @@ +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-1 + + + + 1 TITLE DOSIO - Basic I/O and initialization for 86-DOS and IBM + 2 + 3 = 0200 STKSIZ EQU 200H + 4 + 5 C INCLUDE INTMAC.INC + 6 C ; 8086 Interrupt Handling Macros + 7 C + 8 C + 9 C SAVINT MACRO savloc,intloc,reg + 10 C IFB + 11 C SAVINT savloc,intloc,AX + 12 C ELSE + 13 C MOV reg,intloc + 14 C MOV savloc,reg + 15 C MOV reg,intloc+2 + 16 C MOV savloc+2,reg + 17 C ENDIF + 18 C ENDM + 19 C + 20 C RSTINT MACRO savloc,intloc,reg + 21 C IFB + 22 C SAVINT savloc,intloc,AX + 23 C ELSE + 24 C MOV reg,intloc + 25 C MOV savloc,reg + 26 C MOV reg,intloc+2 + 27 C MOV savloc+2,reg + 28 C ENDIF + 29 C ENDM + 30 C + 31 C MOVINT MACRO savloc,intloc,reg + 32 C IFB + 33 C SAVINT savloc,intloc,AX + 34 C ELSE + 35 C MOV reg,intloc + 36 C MOV savloc,reg + 37 C MOV reg,intloc+2 + 38 C MOV savloc+2,reg + 39 C ENDIF + 40 C ENDM + 41 C + 42 C SETINT MACRO intloc,loc + 43 C MOV word ptr intloc,offset loc + 44 C MOV word ptr intloc+2,CS + 45 C ENDM + 46 C + + + + + + + + + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-2 + + + + 47 C PAGE + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-3 + + + + 48 .list + 49 + 50 = DISABLE EQU CLI + 51 = ENABLE EQU STI + 52 + 53 0000 DATA SEGMENT WORD PUBLIC'DATA' + 54 + 55 EXTRN $$SFWA:WORD, $$SLWA:WORD, $PTRFIL:WORD + 56 + 57 0000 02 [ DIV0_SAVE DW 2 DUP (?) + 58 ???? + 59 ] + 60 + 61 0004 02 [ OVRF_SAVE DW 2 DUP (?) + 62 ???? + 63 ] + 64 + 65 0008 02 [ DSKE_SAVE DW 2 DUP (?) ;Disk Error Interrupt save + 66 ???? + 67 ] + 68 + 69 + 70 000C DATA ENDS + 71 + 72 + 73 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 74 + 75 PUBLIC $TTYWID,$TTYPOS,$EXITSEG + 76 + 77 0000 0000 EXIT DW 0 + 78 0002 0000 $EXITSEG DW 0 + 79 + 80 0004 50 $TTYWID DB 80 + 81 0005 00 $TTYPOS DB 0 + 82 + 83 0006 CONST ENDS + 84 + 85 + 86 0000 MEMORY SEGMENT WORD 'MEMORY' + 87 + 88 0000 MEMRY LABEL BYTE + 89 + 90 0000 MEMORY ENDS + 91 + 92 + 93 0000 STACK SEGMENT WORD STACK 'STACK' + 94 0000 0100 [ DW 100H DUP(?) + 95 ???? + 96 ] + 97 + 98 0200 STACK ENDS + 99 + 100 + 101 DC GROUP CONST,DATA,MEMORY + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-4 + + + + 102 + 103 = 000B STATUS EQU 11 + 104 = 0008 INCHAR EQU 8 + 105 = 0002 OUTCH EQU 2 + 106 = 0005 LISTOUT EQU 5 + 107 + 108 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 109 + 110 PUBLIC $INI,$IOINI,$TTYOT,$LPTOT,$TTYIN,$TTYST,$OSEXT,$ABEND + 111 PUBLIC $LTTYPS,$STTYPS + 112 + 113 ASSUME CS:CODE, DS:DC, ES:DC + 114 + 115 EXTRN $DIV0_INT:NEAR,$OVRF_INT:NEAR + 116 + 117 EXTRN $INI0:NEAR + 118 EXTRN $$WCLF:NEAR + 119 EXTRN $ERC_DME:NEAR, $ERC_DNR:NEAR, $ERC_FWP:NEAR + 120 + 121 ;*** $INI - Run-time initialization + 122 ; + 123 + 124 0000 $INI: + 125 0000 5E POP SI + 126 0001 5F POP DI ;Get return address + 127 0002 BA ---- R MOV DX,DC + 128 0005 8E DA MOV DS,DX ;Get segment of data and constants + 129 0007 8C 06 0002 R MOV [$EXITSEG],ES ;Save exit segment + 130 000B 26: A1 0002 MOV AX,WORD PTR ES:2 ;Get memory size in paragraphs + 131 000F 8E C2 MOV ES,DX + 132 0011 2D 0020 SUB AX,(STKSIZ+15)/16 ;Allow room for stack + 133 0014 8E D0 MOV SS,AX + 134 0016 BC 0200 MOV SP,STKSIZ + 135 0019 57 PUSH DI + 136 001A 56 PUSH SI ;Return address back on stack + 137 001B 2B C2 SUB AX,DX ;Size of data segment + 138 001D 3D 0FFF CMP AX,0FFFH ;More than 64K in data segment? + 139 0020 76 02 JBE FIGSIZ + 140 0022 33 C0 XOR AX,AX + 141 0024 FIGSIZ: + 142 0024 B1 04 MOV CL,4 + 143 0026 D3 E0 SHL AX,CL ;Multiply by 16 to get bytes + 144 0028 48 DEC AX ;Point to last available byte + 145 0029 A3 0000 E MOV [$$SLWA],AX + 146 002C C7 06 0000 E 0000 R MOV [$$SFWA],OFFSET DC:MEMRY + 147 + 148 ASSUME ES:NOTHING + 149 + 150 0032 33 C0 XOR AX,AX ;Clear segment + 151 0034 06 PUSH ES ;Save ES + 152 0035 8E C0 MOV ES,AX ;Set ES to 0:xxxx + 153 0037 9C PUSHF ;Save interrupt status + 154 0038 FA DISABLE ;Turn off interrupts + 155 SAVINT DIV0_SAVE,ES:(0*4) + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-5 + + + + 156 0039 26: A1 0000 + MOV AX,ES:(0*4) + 157 003D A3 0000 R + MOV DIV0_SAVE,AX + 158 0040 26: A1 0002 + MOV AX,ES:(0*4)+2 + 159 0044 A3 0002 R + MOV DIV0_SAVE+2,AX + 160 SAVINT OVRF_SAVE,ES:(4*4) + 161 0047 26: A1 0010 + MOV AX,ES:(4*4) + 162 004B A3 0004 R + MOV OVRF_SAVE,AX + 163 004E 26: A1 0012 + MOV AX,ES:(4*4)+2 + 164 0052 A3 0006 R + MOV OVRF_SAVE+2,AX + 165 SAVINT DSKE_SAVE,ES:(36*4) + 166 0055 26: A1 0090 + MOV AX,ES:(36*4) + 167 0059 A3 0008 R + MOV DSKE_SAVE,AX + 168 005C 26: A1 0092 + MOV AX,ES:(36*4)+2 + 169 0060 A3 000A R + MOV DSKE_SAVE+2,AX + 170 SETINT ES:(0*4),$DIV0_INT + 171 0063 26: C7 06 0000 0000 E + MOV word ptr ES:(0*4),offset $DIV0_INT + 172 006A 26: 8C 0E 0002 + MOV word ptr ES:(0*4)+2,CS + 173 SETINT ES:(4*4),$OVRF_INT + 174 006F 26: C7 06 0010 0000 E + MOV word ptr ES:(4*4),offset $OVRF_INT + 175 0076 26: 8C 0E 0012 + MOV word ptr ES:(4*4)+2,CS + 176 SETINT ES:(36*4),$DSKE_INT + 177 007B 26: C7 06 0090 00B2 R + MOV word ptr ES:(36*4),offset $DSKE_INT + 178 0082 26: 8C 0E 0092 + MOV word ptr ES:(36*4)+2,CS + 179 0087 9D POPF ;Restore interrupts + 180 0088 07 POP ES + 181 + 182 ASSUME ES:DC + 183 + 184 0089 E9 0000 E JMP $INI0 + 185 + 186 + 187 ;*** $IOINI - 86-DOS special I/O initialization + 188 ; + 189 + 190 008C $IOINI: + 191 008C C3 RET + 192 + 193 + 194 ;*** $TTYST - TTY status + 195 ; + 196 ; Inputs: + 197 ; None. + 198 ; Function: + 199 ; Check console for pending character. + 200 ; Outputs: + 201 ; Zero flag clear if character waiting. + 202 ; Zero flag set if none. + 203 ; Registers: + 204 ; Only AX and F affected. + 205 + 206 008D $TTYST: + 207 008D B4 0B MOV AH,STATUS + 208 008F CD 21 INT 33 + 209 0091 0A C0 OR AL,AL + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-6 + + + + 210 0093 C3 RET + 211 + 212 + 213 ;*** $TTYIN - TTY input + 214 ; + 215 ; Inputs: + 216 ; None. + 217 ; Function: + 218 ; Get character from console keyboard + 219 ; Outputs: + 220 ; AL = character + 221 ; Registers: + 222 ; Only AX and F affected. + 223 + 224 0094 $TTYIN: + 225 0094 B4 08 MOV AH,INCHAR + 226 0096 CD 21 INT 33 + 227 0098 C3 RET + 228 + 229 + 230 ;*** $TTYOT and $LPTOT - Character output routines + 231 ; + 232 ; Inputs: + 233 ; AL = Character to output + 234 ; Function: + 235 ; Send character to console video or to printer + 236 ; Outputs: + 237 ; None. + 238 ; Register: + 239 ; No registers or flags affected. + 240 + 241 0099 $LPTOT: + 242 0099 52 PUSH DX + 243 009A 92 XCHG AX,DX + 244 009B B4 05 MOV AH,LISTOUT + 245 009D EB 04 JMP SHORT CHOUT + 246 + 247 009F $TTYOT: + 248 009F 52 PUSH DX + 249 00A0 92 XCHG AX,DX + 250 00A1 B4 02 MOV AH,OUTCH + 251 00A3 CHOUT: + 252 00A3 CD 21 INT 33 + 253 00A5 92 XCHG AX,DX + 254 00A6 5A POP DX + 255 00A7 C3 RET + 256 + 257 + 258 ;** $LTTYPS and $STTYPS - Load and store console position + 259 + 260 00A8 $LTTYPS: + 261 00A8 8A 26 0005 R MOV AH,[$TTYPOS] + 262 00AC C3 RET + 263 + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-7 + + + + 264 00AD $STTYPS: + 265 00AD 88 26 0005 R MOV [$TTYPOS],AH + 266 00B1 C3 RET + 267 + 268 + 269 + 270 ; $DSKE_INT - Disk Errors vector here via Interrupt 36. + 271 ; [DI] has Error code as follows: + 272 ; 00 - Disk Write Protected. + 273 ; 02 - Disk Not Ready + 274 ; 04 - Data Error + 275 ; 06 - Seek Error + 276 ; 08 - Sector not found + 277 ; 10 - Write Fault (hard disks only) + 278 ; 12 - Other error. + 279 + 280 00B2 $DSKE_INT: + 281 00B2 FB ENABLE + 282 00B3 8B C7 MOV AX,DI ;Get error code in [AL] + 283 00B5 83 C4 14 ADD SP,20 ;Move stack for POP's + 284 00B8 1F POP DS ;Get Runtime's DS + 285 00B9 07 POP ES ;Get Runtime's ES + 286 00BA 0A C0 OR AL,AL + 287 00BC 75 03 JNZ $DSKE_ER2 + 288 00BE E9 0000 E JMP $ERC_FWP ;Brif "Disk Write Protected" + 289 00C1 $DSKE_ER2: + 290 00C1 3C 02 CMP AL,2 + 291 00C3 75 03 JNZ $DSKE_ER3 + 292 00C5 E9 0000 E JMP $ERC_DNR ;Brif "Disk not Ready" + 293 00C8 $DSKE_ER3: + 294 00C8 E9 0000 E JMP $ERC_DME ; ..else "Disk Media Error" + 295 + 296 + 297 + 298 ;*** $OSEXT - Return to 86-DOS + 299 + 300 00CB $ABEND: ;Serious error + 301 00CB $OSEXT: ;'C' set on BASIC trapped error + 302 + 303 ASSUME ES:NOTHING + 304 + 305 00CB 33 C0 XOR AX,AX ;Clear segment + 306 00CD 06 PUSH ES ;Save ES + 307 00CE 8E C0 MOV ES,AX ;Set ES to 0:xxxx + 308 00D0 9C PUSHF ;Save interrupt status + 309 00D1 FA DISABLE ;Turn off interrupts + 310 RSTINT ES:(0*4),DIV0_SAVE + 311 00D2 A1 0000 R + MOV AX,DIV0_SAVE + 312 00D5 26: A3 0000 + MOV ES:(0*4),AX + 313 00D9 A1 0002 R + MOV AX,DIV0_SAVE+2 + 314 00DC 26: A3 0002 + MOV ES:(0*4)+2,AX + 315 RSTINT ES:(4*4),OVRF_SAVE + 316 00E0 A1 0004 R + MOV AX,OVRF_SAVE + 317 00E3 26: A3 0010 + MOV ES:(4*4),AX + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Page 1-8 + + + + 318 00E7 A1 0006 R + MOV AX,OVRF_SAVE+2 + 319 00EA 26: A3 0012 + MOV ES:(4*4)+2,AX + 320 RSTINT ES:(36*4),DSKE_SAVE + 321 00EE A1 0008 R + MOV AX,DSKE_SAVE + 322 00F1 26: A3 0090 + MOV ES:(36*4),AX + 323 00F5 A1 000A R + MOV AX,DSKE_SAVE+2 + 324 00F8 26: A3 0092 + MOV ES:(36*4)+2,AX + 325 00FC 9D POPF ;Restore interrupts + 326 00FD 07 POP ES ;Restore ES + 327 + 328 ASSUME ES:DC + 329 + 330 00FE FF 2E 0000 R JMP DWORD PTR [EXIT] + 331 + 332 0102 CODE ENDS + 333 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 +MOVINT . . . . . . . . . . . . . 0003 +RSTINT . . . . . . . . . . . . . 0003 +SAVINT . . . . . . . . . . . . . 0003 +SETINT . . . . . . . . . . . . . 0002 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS . . . . . . . . . . . 0032 + FD_BUFFER . . . . . . . . . . . 0033 + FD_VRECL . . . . . . . . . . . . 00B3 + FD_PHYREC. . . . . . . . . . . . 00B5 + FD_LOGREC. . . . . . . . . . . . 00B7 + FD_OUTPOS. . . . . . . . . . . . 00BA + FD_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0102 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0006 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 000C WORD PUBLIC 'DATA' +MEMORY . . . . . . . . . . . . . 0000 WORD NONE 'MEMORY' +STACK. . . . . . . . . . . . . . 0200 WORD STACK 'STACK' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Symbols-2 + + + +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +CHOUT. . . . . . . . . . . . . . L NEAR 00A3 CODE +DISABLE. . . . . . . . . . . . . Opcode +DIV0_SAVE. . . . . . . . . . . . L WORD 0000 DATA Length =0002 +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DSKE_SAVE. . . . . . . . . . . . L WORD 0008 DATA Length =0002 +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +ENABLE . . . . . . . . . . . . . Opcode +EOFCHR . . . . . . . . . . . . . Number 001A +EXIT . . . . . . . . . . . . . . L WORD 0000 CONST +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FIGSIZ . . . . . . . . . . . . . L NEAR 0024 CODE +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +INCHAR . . . . . . . . . . . . . Number 0008 +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LISTOUT. . . . . . . . . . . . . Number 0005 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +MEMRY. . . . . . . . . . . . . . L BYTE 0000 MEMORY +OUTCH. . . . . . . . . . . . . . Number 0002 +OVRF_SAVE. . . . . . . . . . . . L WORD 0004 DATA Length =0002 +REC_LENGTH . . . . . . . . . . . Number 0080 +STATUS . . . . . . . . . . . . . Number 000B +STKSIZ . . . . . . . . . . . . . Number 0200 +$$SFWA . . . . . . . . . . . . . V WORD 0000 DATA External +$$SLWA . . . . . . . . . . . . . V WORD 0000 DATA External +$$WCLF . . . . . . . . . . . . . L NEAR 0000 CODE External +$ABEND . . . . . . . . . . . . . L NEAR 00CB CODE Global +$DIV0_INT. . . . . . . . . . . . L NEAR 0000 CODE External +$DSKE_ER2. . . . . . . . . . . . L NEAR 00C1 CODE + + +DOSIO - Basic I/O and initialization for 86-DOS and IBM Macro-86 %1(12) 1:0:27 13-Nov-81 Symbols-3 + + + +$DSKE_ER3. . . . . . . . . . . . L NEAR 00C8 CODE +$DSKE_INT. . . . . . . . . . . . L NEAR 00B2 CODE +$ERC_DME . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_DNR . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FWP . . . . . . . . . . . . L NEAR 0000 CODE External +$EXITSEG . . . . . . . . . . . . L WORD 0002 CONST Global +$INI . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$INI0. . . . . . . . . . . . . . L NEAR 0000 CODE External +$IOINI . . . . . . . . . . . . . L NEAR 008C CODE Global +$LPTOT . . . . . . . . . . . . . L NEAR 0099 CODE Global +$LTTYPS. . . . . . . . . . . . . L NEAR 00A8 CODE Global +$OSEXT . . . . . . . . . . . . . L NEAR 00CB CODE Global +$OVRF_INT. . . . . . . . . . . . L NEAR 0000 CODE External +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +$STTYPS. . . . . . . . . . . . . L NEAR 00AD CODE Global +$TTYIN . . . . . . . . . . . . . L NEAR 0094 CODE Global +$TTYOT . . . . . . . . . . . . . L NEAR 009F CODE Global +$TTYPOS. . . . . . . . . . . . . L BYTE 0005 CONST Global +$TTYST . . . . . . . . . . . . . L NEAR 008D CODE Global +$TTYWID. . . . . . . . . . . . . L BYTE 0004 CONST Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/DOSIO.ASM b/3_source_code/BASLIB-86/DOSIO.ASM new file mode 100644 index 0000000..b6fdebb --- /dev/null +++ b/3_source_code/BASLIB-86/DOSIO.ASM @@ -0,0 +1,249 @@ + TITLE DOSIO - Basic I/O and initialization for 86-DOS and IBM + +STKSIZ EQU 200H + + INCLUDE INTMAC.INC +.list + +DISABLE EQU CLI +ENABLE EQU STI + +DATA SEGMENT WORD PUBLIC'DATA' + + EXTRN $$SFWA:WORD, $$SLWA:WORD, $PTRFIL:WORD + +DIV0_SAVE DW 2 DUP (?) +OVRF_SAVE DW 2 DUP (?) +DSKE_SAVE DW 2 DUP (?) ;Disk Error Interrupt save + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + PUBLIC $TTYWID,$TTYPOS,$EXITSEG + +EXIT DW 0 +$EXITSEG DW 0 + +$TTYWID DB 80 +$TTYPOS DB 0 + +CONST ENDS + + +MEMORY SEGMENT WORD 'MEMORY' + +MEMRY LABEL BYTE + +MEMORY ENDS + + +STACK SEGMENT WORD STACK 'STACK' + DW 100H DUP(?) +STACK ENDS + + +DC GROUP CONST,DATA,MEMORY + +STATUS EQU 11 +INCHAR EQU 8 +OUTCH EQU 2 +LISTOUT EQU 5 + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $INI,$IOINI,$TTYOT,$LPTOT,$TTYIN,$TTYST,$OSEXT,$ABEND + PUBLIC $LTTYPS,$STTYPS + + ASSUME CS:CODE, DS:DC, ES:DC + + EXTRN $DIV0_INT:NEAR,$OVRF_INT:NEAR + + EXTRN $INI0:NEAR + EXTRN $$WCLF:NEAR + EXTRN $ERC_DME:NEAR, $ERC_DNR:NEAR, $ERC_FWP:NEAR + +;*** $INI - Run-time initialization +; + +$INI: + POP SI + POP DI ;Get return address + MOV DX,DC + MOV DS,DX ;Get segment of data and constants + MOV [$EXITSEG],ES ;Save exit segment + MOV AX,WORD PTR ES:2 ;Get memory size in paragraphs + MOV ES,DX + SUB AX,(STKSIZ+15)/16 ;Allow room for stack + MOV SS,AX + MOV SP,STKSIZ + PUSH DI + PUSH SI ;Return address back on stack + SUB AX,DX ;Size of data segment + CMP AX,0FFFH ;More than 64K in data segment? + JBE FIGSIZ + XOR AX,AX +FIGSIZ: + MOV CL,4 + SHL AX,CL ;Multiply by 16 to get bytes + DEC AX ;Point to last available byte + MOV [$$SLWA],AX + MOV [$$SFWA],OFFSET DC:MEMRY + +ASSUME ES:NOTHING + + XOR AX,AX ;Clear segment + PUSH ES ;Save ES + MOV ES,AX ;Set ES to 0:xxxx + PUSHF ;Save interrupt status + DISABLE ;Turn off interrupts + SAVINT DIV0_SAVE,ES:(0*4) + SAVINT OVRF_SAVE,ES:(4*4) + SAVINT DSKE_SAVE,ES:(36*4) + SETINT ES:(0*4),$DIV0_INT + SETINT ES:(4*4),$OVRF_INT + SETINT ES:(36*4),$DSKE_INT + POPF ;Restore interrupts + POP ES + +ASSUME ES:DC + + JMP $INI0 + + +;*** $IOINI - 86-DOS special I/O initialization +; + +$IOINI: + RET + + +;*** $TTYST - TTY status +; +; Inputs: +; None. +; Function: +; Check console for pending character. +; Outputs: +; Zero flag clear if character waiting. +; Zero flag set if none. +; Registers: +; Only AX and F affected. + +$TTYST: + MOV AH,STATUS + INT 33 + OR AL,AL + RET + + +;*** $TTYIN - TTY input +; +; Inputs: +; None. +; Function: +; Get character from console keyboard +; Outputs: +; AL = character +; Registers: +; Only AX and F affected. + +$TTYIN: + MOV AH,INCHAR + INT 33 + RET + + +;*** $TTYOT and $LPTOT - Character output routines +; +; Inputs: +; AL = Character to output +; Function: +; Send character to console video or to printer +; Outputs: +; None. +; Register: +; No registers or flags affected. + +$LPTOT: + PUSH DX + XCHG AX,DX + MOV AH,LISTOUT + JMP SHORT CHOUT + +$TTYOT: + PUSH DX + XCHG AX,DX + MOV AH,OUTCH +CHOUT: + INT 33 + XCHG AX,DX + POP DX + RET + + +;** $LTTYPS and $STTYPS - Load and store console position + +$LTTYPS: + MOV AH,[$TTYPOS] + RET + +$STTYPS: + MOV [$TTYPOS],AH + RET + + + +; $DSKE_INT - Disk Errors vector here via Interrupt 36. +; [DI] has Error code as follows: +; 00 - Disk Write Protected. +; 02 - Disk Not Ready +; 04 - Data Error +; 06 - Seek Error +; 08 - Sector not found +; 10 - Write Fault (hard disks only) +; 12 - Other error. + +$DSKE_INT: + ENABLE + MOV AX,DI ;Get error code in [AL] + ADD SP,20 ;Move stack for POP's + POP DS ;Get Runtime's DS + POP ES ;Get Runtime's ES + OR AL,AL + JNZ $DSKE_ER2 + JMP $ERC_FWP ;Brif "Disk Write Protected" +$DSKE_ER2: + CMP AL,2 + JNZ $DSKE_ER3 + JMP $ERC_DNR ;Brif "Disk not Ready" +$DSKE_ER3: + JMP $ERC_DME ; ..else "Disk Media Error" + + + +;*** $OSEXT - Return to 86-DOS + +$ABEND: ;Serious error +$OSEXT: ;'C' set on BASIC trapped error + +ASSUME ES:NOTHING + + XOR AX,AX ;Clear segment + PUSH ES ;Save ES + MOV ES,AX ;Set ES to 0:xxxx + PUSHF ;Save interrupt status + DISABLE ;Turn off interrupts + RSTINT ES:(0*4),DIV0_SAVE + RSTINT ES:(4*4),OVRF_SAVE + RSTINT ES:(36*4),DSKE_SAVE + POPF ;Restore interrupts + POP ES ;Restore ES + +ASSUME ES:DC + + JMP DWORD PTR [EXIT] + +CODE ENDS + END diff --git a/3_source_code/BASLIB-86/INTMAC.INC b/3_source_code/BASLIB-86/INTMAC.INC new file mode 100644 index 0000000..a9424e9 --- /dev/null +++ b/3_source_code/BASLIB-86/INTMAC.INC @@ -0,0 +1,42 @@ +; 8086 Interrupt Handling Macros + + +SAVINT MACRO savloc,intloc,reg +IFB + SAVINT savloc,intloc,AX +ELSE + MOV reg,intloc + MOV savloc,reg + MOV reg,intloc+2 + MOV savloc+2,reg +ENDIF + ENDM + +RSTINT MACRO savloc,intloc,reg +IFB + SAVINT savloc,intloc,AX +ELSE + MOV reg,intloc + MOV savloc,reg + MOV reg,intloc+2 + MOV savloc+2,reg +ENDIF + ENDM + +MOVINT MACRO savloc,intloc,reg +IFB + SAVINT savloc,intloc,AX +ELSE + MOV reg,intloc + MOV savloc,reg + MOV reg,intloc+2 + MOV savloc+2,reg +ENDIF + ENDM + +SETINT MACRO intloc,loc + MOV word ptr intloc,offset loc + MOV word ptr intloc+2,CS + ENDM + + PAGE From 8efb98d4d08cb33589e05e03eae3f92b9f905d49 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 24 Jun 2026 15:44:52 -0700 Subject: [PATCH 15/53] Transcription of Bundle 9 - DSQRT.ASM Code and Listing --- 2_printed_files/bundle_09/DSQRT.ASM | 180 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DSQRT.ASM | 65 ++++++++++ 2 files changed, 245 insertions(+) create mode 100644 2_printed_files/bundle_09/DSQRT.ASM create mode 100644 3_source_code/BASLIB-86/DSQRT.ASM diff --git a/2_printed_files/bundle_09/DSQRT.ASM b/2_printed_files/bundle_09/DSQRT.ASM new file mode 100644 index 0000000..8b4ec29 --- /dev/null +++ b/2_printed_files/bundle_09/DSQRT.ASM @@ -0,0 +1,180 @@ +DSQRT - Double precision square root Macro-86 %1(12) 1:0:45 13-Nov-81 Page 1-1 + + + + 1 TITLE DSQRT - Double precision square root + 2 + 3 ;The method used here is to get a good estimate using single-precision square + 4 ;root and then use two Newton-Raphson iterations. + 5 + 6 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 7 + 8 EXTRN $FAC:BYTE, $DAC:WORD, $TEMP:WORD, $ARG:WORD + 9 + 10 0000 DATA ENDS + 11 + 12 + 13 DC GROUP DATA + 14 + 15 + 16 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 17 + 18 PUBLIC $SQD + 19 + 20 EXTRN $SAVREG:NEAR, $SSQRT:NEAR, $DDIV:NEAR, $DADD:NEAR + 21 + 22 ASSUME CS:CODE, DS:DC, ES:DC + 23 + 24 + 25 ;*** $SQD - Double precision square root + 26 ; + 27 ; Inputs: + 28 ; BX = Address of operand + 29 ; Outputs: + 30 ; Result in FAC + 31 ; Registers: + 32 ; Only F affected. + 33 + 34 0000 $SQD: + 35 0000 E8 0000 E CALL $SAVREG + 36 0003 8B F3 MOV SI,BX + 37 0005 BF 0000 E MOV DI,OFFSET DC:$ARG + 38 0008 A5 MOVSW ;Move argument to ARG + 39 0009 A5 MOVSW + 40 000A A5 MOVSW + 41 000B A5 MOVSW + 42 000C 83 C3 04 ADD BX,4 ;Pretend argument it single precision + 43 000F E8 0000 E CALL $SSQRT ;Get S.P. square root as first guess + 44 0012 33 C0 XOR AX,AX + 45 0014 A3 0000 E MOV [$DAC],AX + 46 0017 A3 0002 E MOV [$DAC+2],AX ;Zero extended part + 47 001A E8 001D R CALL NEWTON + 48 001D NEWTON: + 49 001D BE 0000 E MOV SI,OFFSET DC:$DAC + 50 0020 BF 0000 E MOV DI,OFFSET DC:$TEMP + 51 0023 A5 MOVSW + 52 0024 A5 MOVSW + 53 0025 A5 MOVSW + 54 0026 A5 MOVSW ;Copy guess to TEMP + + +DSQRT - Double precision square root Macro-86 %1(12) 1:0:45 13-Nov-81 Page 1-2 + + + + 55 0027 BE 0000 E MOV SI,OFFSET DC:$ARG + 56 002A BF 0000 E MOV DI,OFFSET DC:$DAC + 57 002D E8 0000 E CALL $DDIV ;DAC = ARG/guess + 58 0030 BE 0000 E MOV SI,OFFSET DC:$DAC + 59 0033 BF 0000 E MOV DI,OFFSET DC:$TEMP + 60 0036 E8 0000 E CALL $DADD ;DAC = guess + (ARG/guess) + 61 0039 FE 0E 0000 E DEC [$FAC] ;DAC = [guess + (ARG/guess)] / 2 + 62 003D C3 RET + 63 + 64 003E CODE ENDS + 65 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +DSQRT - Double precision square root Macro-86 %1(12) 1:0:45 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 003E BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +NEWTON . . . . . . . . . . . . . L NEAR 001D CODE +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SQD . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$SSQRT . . . . . . . . . . . . . L NEAR 0000 CODE External +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/DSQRT.ASM b/3_source_code/BASLIB-86/DSQRT.ASM new file mode 100644 index 0000000..da173d8 --- /dev/null +++ b/3_source_code/BASLIB-86/DSQRT.ASM @@ -0,0 +1,65 @@ + TITLE DSQRT - Double precision square root + +;The method used here is to get a good estimate using single-precision square +;root and then use two Newton-Raphson iterations. + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE, $DAC:WORD, $TEMP:WORD, $ARG:WORD + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $SQD + + EXTRN $SAVREG:NEAR, $SSQRT:NEAR, $DDIV:NEAR, $DADD:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $SQD - Double precision square root +; +; Inputs: +; BX = Address of operand +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$SQD: + CALL $SAVREG + MOV SI,BX + MOV DI,OFFSET DC:$ARG + MOVSW ;Move argument to ARG + MOVSW + MOVSW + MOVSW + ADD BX,4 ;Pretend argument it single precision + CALL $SSQRT ;Get S.P. square root as first guess + XOR AX,AX + MOV [$DAC],AX + MOV [$DAC+2],AX ;Zero extended part + CALL NEWTON +NEWTON: + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + MOVSW + MOVSW + MOVSW + MOVSW ;Copy guess to TEMP + MOV SI,OFFSET DC:$ARG + MOV DI,OFFSET DC:$DAC + CALL $DDIV ;DAC = ARG/guess + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$TEMP + CALL $DADD ;DAC = guess + (ARG/guess) + DEC [$FAC] ;DAC = [guess + (ARG/guess)] / 2 + RET + +CODE ENDS + END From df935b3cf766a20bcfa84a4798432a6c5e57f0cd Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 24 Jun 2026 16:38:13 -0700 Subject: [PATCH 16/53] Transcription of Bundle 9 - ERROR.ASM Code and Listing Created file ADDR.INC from listing, required for build. (See line 8 for include statement, lines 9-12 for content) --- 2_printed_files/bundle_09/ERROR.ASM | 300 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/ADDR.INC | 4 + 3_source_code/BASLIB-86/ERROR.ASM | 161 +++++++++++++++ 3 files changed, 465 insertions(+) create mode 100644 2_printed_files/bundle_09/ERROR.ASM create mode 100644 3_source_code/BASLIB-86/ADDR.INC create mode 100644 3_source_code/BASLIB-86/ERROR.ASM diff --git a/2_printed_files/bundle_09/ERROR.ASM b/2_printed_files/bundle_09/ERROR.ASM new file mode 100644 index 0000000..fc0cb92 --- /dev/null +++ b/2_printed_files/bundle_09/ERROR.ASM @@ -0,0 +1,300 @@ +ERROR - Error trapping for 8086 Basic Compiler Macro-86 %1(12) 1:0:48 13-Nov-81 Page 1-1 + + + + 1 TITLE ERROR - Error trapping for 8086 Basic Compiler + 2 + 3 + 4 ; This module contains the run-time support for error trapping + 5 ; in addition to the routines in GOSTOP. + 6 + 7 + 8 C INCLUDE ADDR.INC + 9 = 0000 C O_STA EQU 0 ;Statement address/number table + 10 = 0002 C STARTDATA EQU 2 ;Start of data statements + 11 = 0006 C O_RAM EQU 6 ;Start of user RAM + 12 = 000C C O_RAL EQU 0CH ;End of user RAM + 1 + 13 + 14 + 15 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 16 + 17 EXTRN $$AOER:WORD, $$OEIP:BYTE + 18 EXTRN $ERRADR:WORD,$ERRNUM:WORD,$ERRLIN:WORD + 19 EXTRN $MAINBASE:WORD + 20 + 21 0000 DATA ENDS + 22 + 23 DC GROUP DATA + 24 + 25 + 26 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 27 + 28 ASSUME CS:CODE, DS:DC, ES:DC + 29 + 30 PUBLIC $RESA,$RSN,$RS0 + 31 PUBLIC $OEGA,$ON0 + 32 PUBLIC $ERL,$ERN + 33 + 34 EXTRN $ERR_RE:NEAR + 35 EXTRN $$FSFA:NEAR, $FOE:NEAR, $FSERR:NEAR, $GETAD:NEAR + 36 EXTRN $SNORM:NEAR + 37 + 38 + 39 0000 Entries PROC FAR + 40 + 41 + 42 ;** $OEGA - ON ERROR GOTO line number + 43 ; + 44 ; ENTRY (BX) = line number address + 45 + 46 0000 89 1E 0000 E $OEGA: MOV [$$AOER],BX ;Set error vector + 47 0004 CB onret: RET + 48 + 49 + 50 ;** $ON0 - ON ERROR GOTO 0 + 51 ; + 52 ; ENTRY none + 53 + 54 0005 C7 06 0000 E 0000 $ON0: MOV [$$AOER],0 ;Clear error vector + + +ERROR - Error trapping for 8086 Basic Compiler Macro-86 %1(12) 1:0:48 13-Nov-81 Page 1-2 + + + + 55 000B 80 3E 0000 E 00 CMP [$$OEIP],0 ;Test if error in progress + 56 0010 74 F2 JE onret ; No - just return + 57 + 58 ; In error handling routine, must pretend we just had last error + 59 + 60 0012 5B POP BX ;Toss $ON0 return offset + 61 0013 FF 36 0000 E PUSH [$ERRADR] ;Use error offset as return address + 62 0017 8B 1E 0000 E MOV BX,[$ERRNUM] ;Get error number + 63 001B E9 0000 E JMP $FOE ;Process error + 64 + 65 + 66 ;** $RESA - RESUME line number + 67 ; + 68 ; ENTRY (BX) = line number address + 69 + 70 001E 80 3E 0000 E 00 $RESA: CMP [$$OEIP],0 ;Test if error is in progress + 71 0023 74 08 JE errre ; No - RESUME without error + 72 + 73 0025 C6 06 0000 E 00 MOV [$$OEIP],0 ;Clear error in progress flag + 74 002A 58 POP AX ;Throw away return offset + 75 002B 53 PUSH BX ;Save line number as offset + 76 002C CB rsnret: RET ;Return to specified line number + 77 + 78 002D E9 0000 E errre: JMP $ERR_RE ;Give error + 79 + 80 + 81 ;** $RS0 - RESUME [0] + 82 ; + 83 ; ENTRY none + 84 + 85 0030 80 3E 0000 E 00 $RS0: CMP [$$OEIP],0 ;Test if error is in progress + 86 0035 74 F6 JE errre ; No - RESUME without error + 87 + 88 0037 C6 06 0000 E 00 MOV [$$OEIP],0 ;Clear error in progress flag + 89 003C 58 POP AX ;Toss return offset + 90 003D A1 0000 E MOV AX,[$ERRADR] ;Get error address + 91 0040 E8 0000 E CALL $$FSFA ;(BX) = address of start of statement + 92 0043 53 PUSH BX ;Save as offset + 93 0044 CB RET ;Return to start of statement + 94 + 95 + 96 ;** $RSN - RESUME NEXT + 97 ; + 98 ; ENTRY none + 99 + 100 0045 80 3E 0000 E 00 $RSN: CMP [$$OEIP],0 ;Test if error is in progress + 101 004A 74 E1 JE errre ; No - RESUME without error + 102 + 103 004C C6 06 0000 E 00 MOV [$$OEIP],0 ;Clear errr in progress flag + 104 0051 8B 0E 0000 E MOV CX,[$ERRADR] ;Get return offset + 105 0055 E8 0000 E CALL $GETAD ;Get statement number address table + 106 0058 00 DB O_STA + 107 0059 96 XCHG AX,SI + 108 005A 8E 1E 0002 E MOV DS,[$MAINBASE+2] ;Get main program CS + + +ERROR - Error trapping for 8086 Basic Compiler Macro-86 %1(12) 1:0:48 13-Nov-81 Page 1-3 + + + + 109 005E BB FFFF MOV BX,-1 ;Start out with maximum address + 110 + 111 0061 AD rsnlop: LODSW ;(AX) = next address to check + 112 0062 0B C0 OR AX,AX ;Check if end of table + 113 0064 74 0D JZ rsnend ; Yes + 114 + 115 0066 3B C1 CMP AX,CX ;Are we less than original address + 116 0068 72 05 JB rsnnxt ; Yes - skip this one + 117 006A 3B C3 CMP AX,BX ;Are we less than current closest + 118 006C 73 01 JAE rsnnxt ; No - skip this one + 119 + 120 006E 93 XCHG AX,BX ;Save address in (BX) as new closest + 121 + 122 006F 46 rsnnxt: INC SI ;Skip line number entry + 123 0070 46 INC SI + 124 0071 EB EE JMP rsnlop ;Keep looping + 125 + 126 0073 06 rsnend: PUSH ES ;Restore DS + 127 0074 1F POP DS + 128 0075 58 POP AX ;Toss RESUME NEXT return offset + 129 0076 53 PUSH BX ;Save address for return + 130 0077 43 INC BX ;Bump by 1 to map -1 to 0 (maybe) + 131 0078 75 B2 JNZ rsnret ; Not 0 - return to user program + 132 007A E9 0000 E JMP $FSERR ;Error - no line number found + 133 + 134 + 135 + 136 ;** $ERN - ERR function + 137 ; + 138 ; EXIT (BX) = error number + 139 + 140 007D 8B 1E 0000 E $ERN: MOV BX,[$ERRNUM] ;Get error number + 141 0081 CB RET + 142 + 143 + 144 ;** $ERL - ERL function + 145 ; + 146 ; EXIT (FAC) = error line number + 147 + 148 0082 50 $ERL: PUSH AX + 149 0083 52 PUSH DX + 150 0084 53 PUSH BX + 151 0085 B8 9000 MOV AX,(128+16)*100H ;(AX) = (exponent,sign) + 152 0088 33 D2 XOR DX,DX + 153 008A 8B 1E 0000 E MOV BX,[$ERRLIN] ;(BX,DX) = (line number,0) + 154 008E E8 0000 E CALL $SNORM ;Normalize it into $AC + 155 0091 5B POP BX + 156 0092 5A POP DX + 157 0093 58 POP AX + 158 0094 CB RET + 159 + 160 + 161 0095 Entries ENDP + 162 + + +ERROR - Error trapping for 8086 Basic Compiler Macro-86 %1(12) 1:0:48 13-Nov-81 Page 1-4 + + + + 163 0095 CODE ENDS + 164 + 165 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +ERROR - Error trapping for 8086 Basic Compiler Macro-86 %1(12) 1:0:48 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0095 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ENTRIES. . . . . . . . . . . . . F PROC 0000 CODE Length =0095 +ERRRE. . . . . . . . . . . . . . L NEAR 002D CODE +ONRET. . . . . . . . . . . . . . L NEAR 0004 CODE +O_RAL. . . . . . . . . . . . . . Number 000C +O_RAM. . . . . . . . . . . . . . Number 0006 +O_STA. . . . . . . . . . . . . . Number 0000 +RSNEND . . . . . . . . . . . . . L NEAR 0073 CODE +RSNLOP . . . . . . . . . . . . . L NEAR 0061 CODE +RSNNXT . . . . . . . . . . . . . L NEAR 006F CODE +RSNRET . . . . . . . . . . . . . L NEAR 002C CODE +STARTDATA. . . . . . . . . . . . Number 0002 +$$AOER . . . . . . . . . . . . . V WORD 0000 DATA External +$$FSFA . . . . . . . . . . . . . L NEAR 0000 CODE External +$$OEIP . . . . . . . . . . . . . V BYTE 0000 DATA External +$ERL . . . . . . . . . . . . . . L NEAR 0082 CODE Global +$ERN . . . . . . . . . . . . . . L NEAR 007D CODE Global +$ERRADR. . . . . . . . . . . . . V WORD 0000 DATA External +$ERRLIN. . . . . . . . . . . . . V WORD 0000 DATA External +$ERRNUM. . . . . . . . . . . . . V WORD 0000 DATA External +$ERR_RE. . . . . . . . . . . . . L NEAR 0000 CODE External +$FOE . . . . . . . . . . . . . . L NEAR 0000 CODE External +$FSERR . . . . . . . . . . . . . L NEAR 0000 CODE External +$GETAD . . . . . . . . . . . . . L NEAR 0000 CODE External +$MAINBASE. . . . . . . . . . . . V WORD 0000 DATA External +$OEGA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$ON0 . . . . . . . . . . . . . . L NEAR 0005 CODE Global +$RESA. . . . . . . . . . . . . . L NEAR 001E CODE Global +$RS0 . . . . . . . . . . . . . . L NEAR 0030 CODE Global +$RSN . . . . . . . . . . . . . . L NEAR 0045 CODE Global +$SNORM . . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/ADDR.INC b/3_source_code/BASLIB-86/ADDR.INC new file mode 100644 index 0000000..4ea6c7c --- /dev/null +++ b/3_source_code/BASLIB-86/ADDR.INC @@ -0,0 +1,4 @@ +O_STA EQU 0 ;Statement address/number table +STARTDATA EQU 2 ;Start of data statements +O_RAM EQU 6 ;Start of user RAM +O_RAL EQU 0CH ;End of user RAM + 1 diff --git a/3_source_code/BASLIB-86/ERROR.ASM b/3_source_code/BASLIB-86/ERROR.ASM new file mode 100644 index 0000000..ddc838b --- /dev/null +++ b/3_source_code/BASLIB-86/ERROR.ASM @@ -0,0 +1,161 @@ + TITLE ERROR - Error trapping for 8086 Basic Compiler + + +; This module contains the run-time support for error trapping +; in addition to the routines in GOSTOP. + + + INCLUDE ADDR.INC + + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$AOER:WORD, $$OEIP:BYTE + EXTRN $ERRADR:WORD,$ERRNUM:WORD,$ERRLIN:WORD + EXTRN $MAINBASE:WORD + +DATA ENDS + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + + PUBLIC $RESA,$RSN,$RS0 + PUBLIC $OEGA,$ON0 + PUBLIC $ERL,$ERN + + EXTRN $ERR_RE:NEAR + EXTRN $$FSFA:NEAR, $FOE:NEAR, $FSERR:NEAR, $GETAD:NEAR + EXTRN $SNORM:NEAR + + +Entries PROC FAR + + +;** $OEGA - ON ERROR GOTO line number +; +; ENTRY (BX) = line number address + +$OEGA: MOV [$$AOER],BX ;Set error vector +onret: RET + + +;** $ON0 - ON ERROR GOTO 0 +; +; ENTRY none + +$ON0: MOV [$$AOER],0 ;Clear error vector + CMP [$$OEIP],0 ;Test if error in progress + JE onret ; No - just return + +; In error handling routine, must pretend we just had last error + + POP BX ;Toss $ON0 return offset + PUSH [$ERRADR] ;Use error offset as return address + MOV BX,[$ERRNUM] ;Get error number + JMP $FOE ;Process error + + +;** $RESA - RESUME line number +; +; ENTRY (BX) = line number address + +$RESA: CMP [$$OEIP],0 ;Test if error is in progress + JE errre ; No - RESUME without error + + MOV [$$OEIP],0 ;Clear error in progress flag + POP AX ;Throw away return offset + PUSH BX ;Save line number as offset +rsnret: RET ;Return to specified line number + +errre: JMP $ERR_RE ;Give error + + +;** $RS0 - RESUME [0] +; +; ENTRY none + +$RS0: CMP [$$OEIP],0 ;Test if error is in progress + JE errre ; No - RESUME without error + + MOV [$$OEIP],0 ;Clear error in progress flag + POP AX ;Toss return offset + MOV AX,[$ERRADR] ;Get error address + CALL $$FSFA ;(BX) = address of start of statement + PUSH BX ;Save as offset + RET ;Return to start of statement + + +;** $RSN - RESUME NEXT +; +; ENTRY none + +$RSN: CMP [$$OEIP],0 ;Test if error is in progress + JE errre ; No - RESUME without error + + MOV [$$OEIP],0 ;Clear errr in progress flag + MOV CX,[$ERRADR] ;Get return offset + CALL $GETAD ;Get statement number address table + DB O_STA + XCHG AX,SI + MOV DS,[$MAINBASE+2] ;Get main program CS + MOV BX,-1 ;Start out with maximum address + +rsnlop: LODSW ;(AX) = next address to check + OR AX,AX ;Check if end of table + JZ rsnend ; Yes + + CMP AX,CX ;Are we less than original address + JB rsnnxt ; Yes - skip this one + CMP AX,BX ;Are we less than current closest + JAE rsnnxt ; No - skip this one + + XCHG AX,BX ;Save address in (BX) as new closest + +rsnnxt: INC SI ;Skip line number entry + INC SI + JMP rsnlop ;Keep looping + +rsnend: PUSH ES ;Restore DS + POP DS + POP AX ;Toss RESUME NEXT return offset + PUSH BX ;Save address for return + INC BX ;Bump by 1 to map -1 to 0 (maybe) + JNZ rsnret ; Not 0 - return to user program + JMP $FSERR ;Error - no line number found + + + +;** $ERN - ERR function +; +; EXIT (BX) = error number + +$ERN: MOV BX,[$ERRNUM] ;Get error number + RET + + +;** $ERL - ERL function +; +; EXIT (FAC) = error line number + +$ERL: PUSH AX + PUSH DX + PUSH BX + MOV AX,(128+16)*100H ;(AX) = (exponent,sign) + XOR DX,DX + MOV BX,[$ERRLIN] ;(BX,DX) = (line number,0) + CALL $SNORM ;Normalize it into $AC + POP BX + POP DX + POP AX + RET + + +Entries ENDP + +CODE ENDS + + END From 697ff263076dfaece5e8cbb0ceb36fc30daf9043 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 26 Jun 2026 16:16:37 -0700 Subject: [PATCH 17/53] Transcription of Bundle 9 - EXP.ASM Code and Listing --- 2_printed_files/bundle_09/EXP.ASM | 240 ++++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/EXP.ASM | 123 +++++++++++++++ 2 files changed, 363 insertions(+) create mode 100644 2_printed_files/bundle_09/EXP.ASM create mode 100644 3_source_code/BASLIB-86/EXP.ASM diff --git a/2_printed_files/bundle_09/EXP.ASM b/2_printed_files/bundle_09/EXP.ASM new file mode 100644 index 0000000..9b9308b --- /dev/null +++ b/2_printed_files/bundle_09/EXP.ASM @@ -0,0 +1,240 @@ +EXP - Exponential function Macro-86 %1(12) 1:0:55 13-Nov-81 Page 1-1 + + + + 1 TITLE EXP - Exponential function + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:BYTE, $AC:WORD, $ARG:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 + 10 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 11 + 12 EXTRN $LOG2E:WORD + 13 + 14 ;Constants for Hart's 1302, relative error 7.91 + 15 ; 2^x = 1 + xP(x) = Q(x) + 16 ; These constants have been checked with MuMath + 17 + 18 0000 0006 EXPTAB DW 6 ;Degree + 19 0002 7C 88 59 74 DB 07CH,088H,059H,074H ; +0.00020745 57740 3 + 20 0006 E0 97 26 77 DB 0E0H,097H,026H,077H ; +0.0012710 05745 69 + 21 000A C4 1D 1E 7A DB 0C4H,01DH,01EH,07AH ; +0.0096506 50932 02 + 22 000E 5E 50 63 7C DB 05EH,050H,063H,07CH ; +0.055496 56508 324 + 23 0012 1A FE 75 7E DB 01AH,0FEH,075H,07EH ; +0.24022 71381 7633 + 24 0016 18 72 31 80 DB 018H,072H,031H,080H ; +0.69314 71721 3716 + 25 001A 00 00 00 81 DB 000H,000H,000H,081H ; +1.0 + 26 + 27 001E CONST ENDS + 28 + 29 + 30 DC GROUP DATA,CONST + 31 + 32 + 33 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 34 + 35 PUBLIC $EXP, $EXP2 + 36 + 37 EXTRN $SPOLY:NEAR, $SAVREG:NEAR, $SMUL:NEAR, $SSUB:NEAR + 38 EXTRN $INT:FAR, $OVFL:NEAR, $PUT1:NEAR + 39 + 40 ASSUME CS:CODE, DS:DC, ES:DC + 41 + 42 + 43 ;*** $EXP - Exponential (base e) function + 44 ; + 45 ; Inputs: + 46 ; BX = Address of argument + 47 ; Outputs: + 48 ; Result in FAC + 49 ; Registers: + 50 ; Only F affected. + 51 + 52 0000 $EXP: + 53 0000 E8 0000 E CALL $SAVREG + 54 0003 8B F3 MOV SI,BX + + +EXP - Exponential function Macro-86 %1(12) 1:0:55 13-Nov-81 Page 1-2 + + + + 55 0005 BF 0000 E MOV DI,OFFSET DC:$LOG2E ;Log base 2 of e + 56 0008 E8 0000 E CALL $SMUL + 57 + 58 ;*** $EXP2 - Compute 2^(FAC) + 59 ; + 60 ; Inputs: + 61 ; Argument in FAC + 62 ; Outputs: + 63 ; Result in FAC + 64 ; Registers: + 65 ; All registers destroyed + 66 + 67 000B $EXP2: + 68 000B BE 0000 E MOV SI,OFFSET DC:$AC + 69 000E BF 0000 E MOV DI,OFFSET DC:$ARG + 70 0011 A5 MOVSW ;Move argument to ARG + 71 0012 AD LODSW ;Get sign and exponent + 72 0013 AB STOSW + 73 0014 80 FC 88 CMP AH,88H ;True exp. >= 8 means ABS(X) >= 128 + 74 0017 73 40 JAE OVERCHK ; which could cause overflow + 75 0019 80 FC 68 CMP AH,80H-24 ;True exp. < -24 means result is just 1 + 76 001C 72 53 JB ONE ; since EXP(X)=1+X for X<<1 + 77 001E BB 0000 E MOV BX,OFFSET DC:$AC + 78 0021 9A 0000 ---- E CALL $INT ;Perform FLOOR function + 79 0026 FF 36 0002 E PUSH [$AC+2] ;Save so we can convert to 1-byte integer + 80 002A BE 0000 E MOV SI,OFFSET DC:$ARG + 81 002D BF 0000 E MOV DI,OFFSET DC:$AC + 82 0030 E8 0000 E CALL $SSUB ;FAC = X - INT(X) --> FAC >= 0 + 83 0033 80 3E 0000 E 00 CMP [$FAC],0 + 84 0038 74 26 JZ NOPOLY + 85 003A BB 0000 R MOV BX,OFFSET DC:EXPTAB + 86 003D E8 0000 E CALL $SPOLY + 87 0040 FIGEXP: + 88 0040 58 POP AX ;Recover INT(X) + 89 0041 0A E4 OR AH,AH ;Was it zero? + 90 0043 74 2B JZ RET ;If so, we're done + 91 0045 B1 88 MOV CL,88H + 92 0047 2A CC SUB CL,AH ;Amount to shift mantissa right to make int. + 93 0049 98 CBW ;Remember sign + 94 004A 0C 80 OR AL,80H ;Set implied bit + 95 004C D2 E8 SHR AL,CL ;AL now is INT(X) + 96 004E 0A E4 OR AH,AH ;Check sign + 97 0050 75 13 JNZ SUBEXP + 98 0052 00 06 0000 E ADD [$FAC],AL ;Add to exponent + 99 0056 72 05 JC OVER + 100 0058 C3 RET + 101 + 102 0059 OVERCHK: + 103 0059 0A C0 OR AL,AL ;Positive or negative argument? + 104 005B 78 0E JS ZERO + 105 005D E9 0000 E OVER: JMP $OVFL + 106 + 107 0060 NOPOLY: + 108 0060 E8 0000 E CALL $PUT1 + + +EXP - Exponential function Macro-86 %1(12) 1:0:55 13-Nov-81 Page 1-3 + + + + 109 0063 EB DB JMP FIGEXP + 110 + 111 0065 SUBEXP: + 112 0065 28 06 0000 E SUB [$FAC],AL + 113 0069 77 05 JA RET + 114 006B ZERO: + 115 006B C6 06 0000 E 00 MOV [$FAC],0 ;Underflow - force to zero + 116 0070 C3 RET: RET + 117 + 118 0071 ONE: + 119 ;Argument is too small. Jam result to one. + 120 0071 E9 0000 E JMP $PUT1 + 121 + 122 0074 CODE ENDS + 123 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +EXP - Exponential function Macro-86 %1(12) 1:0:55 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0074 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 001E WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +EXPTAB . . . . . . . . . . . . . L WORD 0000 CONST +FIGEXP . . . . . . . . . . . . . L NEAR 0040 CODE +NOPOLY . . . . . . . . . . . . . L NEAR 0060 CODE +ONE. . . . . . . . . . . . . . . L NEAR 0071 CODE +OVER . . . . . . . . . . . . . . L NEAR 005D CODE +OVERCHK. . . . . . . . . . . . . L NEAR 0059 CODE +RET. . . . . . . . . . . . . . . L NEAR 0070 CODE +SUBEXP . . . . . . . . . . . . . L NEAR 0065 CODE +ZERO . . . . . . . . . . . . . . L NEAR 006B CODE +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$EXP . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$EXP2. . . . . . . . . . . . . . L NEAR 000B CODE Global +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$INT . . . . . . . . . . . . . . L FAR 0000 CODE External +$LOG2E . . . . . . . . . . . . . V WORD 0000 CONST External +$OVFL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$PUT1. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SPOLY . . . . . . . . . . . . . L NEAR 0000 CODE External +$SSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/EXP.ASM b/3_source_code/BASLIB-86/EXP.ASM new file mode 100644 index 0000000..bb264e2 --- /dev/null +++ b/3_source_code/BASLIB-86/EXP.ASM @@ -0,0 +1,123 @@ + TITLE EXP - Exponential function + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE, $AC:WORD, $ARG:WORD + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $LOG2E:WORD + +;Constants for Hart's 1302, relative error 7.91 +; 2^x = 1 + xP(x) = Q(x) +; These constants have been checked with MuMath + +EXPTAB DW 6 ;Degree + DB 07CH,088H,059H,074H ; +0.00020745 57740 3 + DB 0E0H,097H,026H,077H ; +0.0012710 05745 69 + DB 0C4H,01DH,01EH,07AH ; +0.0096506 50932 02 + DB 05EH,050H,063H,07CH ; +0.055496 56508 324 + DB 01AH,0FEH,075H,07EH ; +0.24022 71381 7633 + DB 018H,072H,031H,080H ; +0.69314 71721 3716 + DB 000H,000H,000H,081H ; +1.0 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $EXP, $EXP2 + + EXTRN $SPOLY:NEAR, $SAVREG:NEAR, $SMUL:NEAR, $SSUB:NEAR + EXTRN $INT:FAR, $OVFL:NEAR, $PUT1:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $EXP - Exponential (base e) function +; +; Inputs: +; BX = Address of argument +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$EXP: + CALL $SAVREG + MOV SI,BX + MOV DI,OFFSET DC:$LOG2E ;Log base 2 of e + CALL $SMUL + +;*** $EXP2 - Compute 2^(FAC) +; +; Inputs: +; Argument in FAC +; Outputs: +; Result in FAC +; Registers: +; All registers destroyed + +$EXP2: + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG + MOVSW ;Move argument to ARG + LODSW ;Get sign and exponent + STOSW + CMP AH,88H ;True exp. >= 8 means ABS(X) >= 128 + JAE OVERCHK ; which could cause overflow + CMP AH,80H-24 ;True exp. < -24 means result is just 1 + JB ONE ; since EXP(X)=1+X for X<<1 + MOV BX,OFFSET DC:$AC + CALL $INT ;Perform FLOOR function + PUSH [$AC+2] ;Save so we can convert to 1-byte integer + MOV SI,OFFSET DC:$ARG + MOV DI,OFFSET DC:$AC + CALL $SSUB ;FAC = X - INT(X) --> FAC >= 0 + CMP [$FAC],0 + JZ NOPOLY + MOV BX,OFFSET DC:EXPTAB + CALL $SPOLY +FIGEXP: + POP AX ;Recover INT(X) + OR AH,AH ;Was it zero? + JZ RET ;If so, we're done + MOV CL,88H + SUB CL,AH ;Amount to shift mantissa right to make int. + CBW ;Remember sign + OR AL,80H ;Set implied bit + SHR AL,CL ;AL now is INT(X) + OR AH,AH ;Check sign + JNZ SUBEXP + ADD [$FAC],AL ;Add to exponent + JC OVER + RET + +OVERCHK: + OR AL,AL ;Positive or negative argument? + JS ZERO +OVER: JMP $OVFL + +NOPOLY: + CALL $PUT1 + JMP FIGEXP + +SUBEXP: + SUB [$FAC],AL + JA RET +ZERO: + MOV [$FAC],0 ;Underflow - force to zero +RET: RET + +ONE: +;Argument is too small. Jam result to one. + JMP $PUT1 + +CODE ENDS + END From 9c57f07501d51ae063f88955207aa3e9edd72888 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 26 Jun 2026 16:53:31 -0700 Subject: [PATCH 18/53] Transcription of Bundle 9 - FCOMP.ASM Code and Listing --- 2_printed_files/bundle_09/FCOMP.ASM | 180 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/FCOMP.ASM | 99 +++++++++++++++ 2 files changed, 279 insertions(+) create mode 100644 2_printed_files/bundle_09/FCOMP.ASM create mode 100644 3_source_code/BASLIB-86/FCOMP.ASM diff --git a/2_printed_files/bundle_09/FCOMP.ASM b/2_printed_files/bundle_09/FCOMP.ASM new file mode 100644 index 0000000..aca75d0 --- /dev/null +++ b/2_printed_files/bundle_09/FCOMP.ASM @@ -0,0 +1,180 @@ +FCOMP - Floating point compare Macro-86 %1(12) 1:1:0 13-Nov-81 Page 1-1 + + + + 1 TITLE FCOMP - Floating point compare + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $AC:WORD, $DAC:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 DC GROUP DATA + 10 + 11 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 12 + 13 PUBLIC $FCMA,$FCMB,$FCMC,$FCMD,$FCME,$FCMF,$FCMG,$FCMH + 14 PUBLIC $SCMP, $DCMP + 15 + 16 EXTRN $SAVREG:NEAR, $GTMP:NEAR + 17 + 18 ASSUME CS:CODE, DS:DC, ES:DC + 19 + 20 + 21 0000 $FCMD: + 22 0000 BE 0000 E MOV SI,OFFSET DC:$DAC + 23 0003 EB 06 JMP SHORT $FCMB + 24 0005 $FCMH: + 25 0005 E8 0000 E CALL $GTMP + 26 0008 $FCMF: + 27 0008 BF 0000 E MOV DI,OFFSET DC:$DAC + 28 000B $FCMB: + 29 000B E8 0000 E CALL $SAVREG + 30 + 31 ;*** $SCMP and $DCMP - Single and double precision comparison + 32 ; + 33 ; Inputs: + 34 ; SI = Address of first operand + 35 ; DI = Address of second operand + 36 ; Function: + 37 ; Set Carry and Zero flags based on [SI] - [DI] : + 38 ; [SI] > [DI] Carry and zero clear + 39 ; [SI] < [DI] Carry set and zero clear + 40 ; [SI] = [DI] Carry clear and zero set + 41 ; Outputs: + 42 ; Zero and carry flags have result + 43 ; Registers: + 44 ; Destroys all except BP. + 45 + 46 000E $DCMP: + 47 000E B9 0004 MOV CX,4 ;Compare up to 4 words + 48 0011 83 C6 06 ADD SI,6 ;Point to high word of operands + 49 0014 83 C7 06 ADD DI,6 + 50 0017 EB 15 JMP SHORT CMP + 51 + 52 0019 $FCMC: + 53 0019 BE 0000 E MOV SI,OFFSET DC:$AC + 54 001C EB 06 JMP SHORT $FCMA + + +FCOMP - Floating point compare Macro-86 %1(12) 1:1:0 13-Nov-81 Page 1-2 + + + + 55 001E $FCMG: + 56 001E E8 0000 E CALL $GTMP + 57 0021 $FCME: + 58 0021 BF 0000 E MOV DI,OFFSET DC:$AC + 59 0024 $FCMA: + 60 0024 E8 0000 E CALL $SAVREG + 61 + 62 0027 $SCMP: + 63 0027 B9 0002 MOV CX,2 ;Compare up to two words + 64 002A 03 F1 ADD SI,CX ;Point to high word of operands + 65 002C 03 F9 ADD DI,CX + 66 002E CMP: + 67 002E 8B 04 MOV AX,[SI] ;Get exponent and sign of op1 + 68 0030 8B 1D MOV BX,[DI] ;And op2 + 69 0032 0A FF OR BH,BH ;Second operand zero? + 70 0034 74 19 JZ Z2 + 71 0036 0A E4 OR AH,AH ;First operand zero? + 72 0038 74 0F JZ Z1 + 73 003A 32 D8 XOR BL,AL ;Are signs the same? + 74 003C D0 D0 RCL AL,1 ;Put sign of op1 in carry (doesn't change SF) + 75 003E 78 15 JS RET ;Exit if signs different + 76 0040 73 02 JNC MAGCMP ;Comparing positive numbers? + 77 0042 87 F7 XCHG SI,DI ;If not, look for smallest magnitude + 78 0044 MAGCMP: + 79 0044 FD STD + 80 0045 F3/ A7 REPE CMPSW ;Compare magnitudes + 81 0047 FC CLD + 82 0048 C3 RET + 83 + 84 0049 Z1: + 85 ;First operand is zero + 86 0049 0A FF OR BH,BH ;Insure zero flag not set + 87 004B D0 D3 RCL BL,1 ;Put sign bit in carry + 88 004D F5 CMC + 89 004E C3 RET + 90 + 91 004F Z2: + 92 ;Second operand is zero + 93 004F 0A E4 OR AH,AH ;Is first operand zero too? + 94 0051 74 02 JZ RET ;If so, they're equal + 95 0053 D0 D0 RCL AL,1 ;Put sign bit in carry + 96 0055 C3 RET: RET + 97 + 98 0056 CODE ENDS + 99 END + + + + + + + + + + + +FCOMP - Floating point compare Macro-86 %1(12) 1:1:0 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0056 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +CMP. . . . . . . . . . . . . . . L NEAR 002E CODE +MAGCMP . . . . . . . . . . . . . L NEAR 0044 CODE +RET. . . . . . . . . . . . . . . L NEAR 0055 CODE +Z1 . . . . . . . . . . . . . . . L NEAR 0049 CODE +Z2 . . . . . . . . . . . . . . . L NEAR 004F CODE +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DCMP. . . . . . . . . . . . . . L NEAR 000E CODE Global +$FCMA. . . . . . . . . . . . . . L NEAR 0024 CODE Global +$FCMB. . . . . . . . . . . . . . L NEAR 000B CODE Global +$FCMC. . . . . . . . . . . . . . L NEAR 0019 CODE Global +$FCMD. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FCME. . . . . . . . . . . . . . L NEAR 0021 CODE Global +$FCMF. . . . . . . . . . . . . . L NEAR 0008 CODE Global +$FCMG. . . . . . . . . . . . . . L NEAR 001E CODE Global +$FCMH. . . . . . . . . . . . . . L NEAR 0005 CODE Global +$GTMP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SCMP. . . . . . . . . . . . . . L NEAR 0027 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/FCOMP.ASM b/3_source_code/BASLIB-86/FCOMP.ASM new file mode 100644 index 0000000..3a56ea6 --- /dev/null +++ b/3_source_code/BASLIB-86/FCOMP.ASM @@ -0,0 +1,99 @@ + TITLE FCOMP - Floating point compare + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $AC:WORD, $DAC:WORD + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FCMA,$FCMB,$FCMC,$FCMD,$FCME,$FCMF,$FCMG,$FCMH + PUBLIC $SCMP, $DCMP + + EXTRN $SAVREG:NEAR, $GTMP:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +$FCMD: + MOV SI,OFFSET DC:$DAC + JMP SHORT $FCMB +$FCMH: + CALL $GTMP +$FCMF: + MOV DI,OFFSET DC:$DAC +$FCMB: + CALL $SAVREG + +;*** $SCMP and $DCMP - Single and double precision comparison +; +; Inputs: +; SI = Address of first operand +; DI = Address of second operand +; Function: +; Set Carry and Zero flags based on [SI] - [DI] : +; [SI] > [DI] Carry and zero clear +; [SI] < [DI] Carry set and zero clear +; [SI] = [DI] Carry clear and zero set +; Outputs: +; Zero and carry flags have result +; Registers: +; Destroys all except BP. + +$DCMP: + MOV CX,4 ;Compare up to 4 words + ADD SI,6 ;Point to high word of operands + ADD DI,6 + JMP SHORT CMP + +$FCMC: + MOV SI,OFFSET DC:$AC + JMP SHORT $FCMA +$FCMG: + CALL $GTMP +$FCME: + MOV DI,OFFSET DC:$AC +$FCMA: + CALL $SAVREG + +$SCMP: + MOV CX,2 ;Compare up to two words + ADD SI,CX ;Point to high word of operands + ADD DI,CX +CMP: + MOV AX,[SI] ;Get exponent and sign of op1 + MOV BX,[DI] ;And op2 + OR BH,BH ;Second operand zero? + JZ Z2 + OR AH,AH ;First operand zero? + JZ Z1 + XOR BL,AL ;Are signs the same? + RCL AL,1 ;Put sign of op1 in carry (doesn't change SF) + JS RET ;Exit if signs different + JNC MAGCMP ;Comparing positive numbers? + XCHG SI,DI ;If not, look for smallest magnitude +MAGCMP: + STD + REPE CMPSW ;Compare magnitudes + CLD + RET + +Z1: +;First operand is zero + OR BH,BH ;Insure zero flag not set + RCL BL,1 ;Put sign bit in carry + CMC + RET + +Z2: +;Second operand is zero + OR AH,AH ;Is first operand zero too? + JZ RET ;If so, they're equal + RCL AL,1 ;Put sign bit in carry +RET: RET + +CODE ENDS + END From 488cf009840aed384de642e4adf4309ac451300e Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 26 Jun 2026 18:12:05 -0700 Subject: [PATCH 19/53] Transcription of Bundle 9 - FIELD.ASM Code and Listing NOTE there are several extra records in the symbol table that are not in the source code for the listing. This results in "Symbol not defined" errors at lines 48, 51, and 53. This is due to assembler directives to mask the includes. I've found them later in the bundle and will create appropriate include files as I encounter them. --- 2_printed_files/bundle_09/FIELD.ASM | 302 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/FIELD.ASM | 90 +++++++++ 2 files changed, 392 insertions(+) create mode 100644 2_printed_files/bundle_09/FIELD.ASM create mode 100644 3_source_code/BASLIB-86/FIELD.ASM diff --git a/2_printed_files/bundle_09/FIELD.ASM b/2_printed_files/bundle_09/FIELD.ASM new file mode 100644 index 0000000..4d1c4aa --- /dev/null +++ b/2_printed_files/bundle_09/FIELD.ASM @@ -0,0 +1,302 @@ +FIELD - FIELD Statement Processors Macro-86 %1(12) 1:1:4 13-Nov-81 Page 1-1 + + + + 1 TITLE FIELD - FIELD Statement Processors + 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +FIELD - FIELD Statement Processors Macro-86 %1(12) 1:1:4 13-Nov-81 Page 1-2 + + + + 3 .list + 4 + 5 + 6 0000 DATA SEGMENT PUBLIC WORD 'DATA' + 7 + 8 EXTRN $$SPSV:WORD + 9 + 10 0000 ???? FIELD_LEFT DW ? ;Bytes left in field buffer + 11 0002 ???? FIELD_POS DW ? ;Current field position + 12 + 13 0004 DATA ENDS + 14 + 15 DC GROUP DATA + 16 + 17 + 18 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 19 + 20 ASSUME CS:CODE, DS:DC, ES:DC + 21 + 22 + 23 ; Run-time entries + 24 + 25 PUBLIC $FLDA,$FLDB + 26 + 27 ; Externals + 28 + 29 EXTRN $FBLOC:NEAR, $$FSS:NEAR + 30 + 31 EXTRN $ERC_IFN:NEAR + 32 EXTRN $ERC_BFM:NEAR + 33 EXTRN $ERC_FOV:NEAR + 34 EXTRN $ERC_FC:NEAR + 35 + 36 + 37 0000 Entries PROC FAR + 38 + 39 ;** $FLDA - Field statement preamble + 40 ; + 41 ; ENTRY (BX) = file number + 42 + 43 0000 89 26 0000 E $FLDA: MOV [$$SPSV],SP ;Record stack pointer + 44 0004 50 PUSH AX + 45 0005 56 PUSH SI + 46 0006 E8 0000 E CALL $FBLOC ;Find FDB + 47 0009 74 37 JZ ercifn ; Not found + 48 000B 80 3C 04 CMP [SI].FD_MODE,MD_RND + 49 000E 75 35 JNE ercbfm + 50 + 51 0010 8B 84 00B3 MOV AX,[SI].FR_VRECL + 52 0014 A3 0000 R MOV [FIELD_LEFT],AX ;Save field length + 53 0017 81 C6 00BC ADD SI,FR_FIELD ;(SI) = field buffer address + 54 001B 89 36 0002 R MOV [FIELD_POS],SI ;Save address + 55 001F 5E POP SI + 56 0020 58 POP AX + + +FIELD - FIELD Statement Processors Macro-86 %1(12) 1:1:4 13-Nov-81 Page 1-3 + + + + 57 0021 CB RET + 58 + 59 + 60 + 61 ;** $FLDB - Field assignment + 62 ; + 63 ; ENTRY (BX) = String descriptor + 64 ; (DX) = field length + 65 + 66 0022 89 26 0000 E $FLDB: MOV [$$SPSV],SP + 67 0026 0B D2 OR DX,DX + 68 0028 78 1E JS ercfc ;Can't have negative field length + 69 002A 50 PUSH AX + 70 002B 29 16 0000 R SUB [FIELD_LEFT],DX ;Count off current field + 71 002F 72 1A JB ercfov ; Too big + 72 0031 E8 0000 E CALL $$FSS ;Free string space + 73 0034 A1 0002 R MOV AX,[FIELD_POS] ;Get current field position + 74 0037 89 17 MOV [BX],DX ;Set new string length + 75 0039 89 47 02 MOV [BX+2],AX ;Set new string address + 76 003C 01 16 0002 R ADD [FIELD_POS],DX ;Bump to next field position + 77 0040 58 POP AX + 78 0041 CB RET + 79 + 80 + 81 0042 E9 0000 E ercifn: JMP $ERC_IFN + 82 0045 E9 0000 E ercbfm: JMP $ERC_BFM + 83 0048 E9 0000 E ercfc: JMP $ERC_FC + 84 004B E9 0000 E ercfov: JMP $ERC_FOV + 85 + 86 004E Entries ENDP + 87 + 88 004E CODE ENDS + 89 + 90 END + + + + + + + + + + + + + + + + + + + + + + +FIELD - FIELD Statement Processors Macro-86 %1(12) 1:1:4 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 004E BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0004 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 + + +FIELD - FIELD Statement Processors Macro-86 %1(12) 1:1:4 13-Nov-81 Symbols-2 + + + +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_Width . . . . . . . . . . . . Number 0008 +ENTRIES. . . . . . . . . . . . . F PROC 0000 CODE Length =004E +EOFCHR . . . . . . . . . . . . . Number 001A +ERCBFM . . . . . . . . . . . . . L NEAR 0045 CODE +ERCFC. . . . . . . . . . . . . . L NEAR 0048 CODE +ERCFOV . . . . . . . . . . . . . L NEAR 004B CODE +ERCIFN . . . . . . . . . . . . . L NEAR 0042 CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FIELD_LEFT . . . . . . . . . . . L WORD 0000 DATA +FIELD_POS. . . . . . . . . . . . L WORD 0002 DATA +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +REC_LENGTH . . . . . . . . . . . Number 0080 +$$FSS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FOV . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IFN . . . . . . . . . . . . L NEAR 0000 CODE External +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE External +$FLDA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FLDB. . . . . . . . . . . . . . L NEAR 0022 CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + diff --git a/3_source_code/BASLIB-86/FIELD.ASM b/3_source_code/BASLIB-86/FIELD.ASM new file mode 100644 index 0000000..4eec77c --- /dev/null +++ b/3_source_code/BASLIB-86/FIELD.ASM @@ -0,0 +1,90 @@ + TITLE FIELD - FIELD Statement Processors + +.list + + +DATA SEGMENT PUBLIC WORD 'DATA' + + EXTRN $$SPSV:WORD + +FIELD_LEFT DW ? ;Bytes left in field buffer +FIELD_POS DW ? ;Current field position + +DATA ENDS + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + + +; Run-time entries + + PUBLIC $FLDA,$FLDB + +; Externals + + EXTRN $FBLOC:NEAR, $$FSS:NEAR + + EXTRN $ERC_IFN:NEAR + EXTRN $ERC_BFM:NEAR + EXTRN $ERC_FOV:NEAR + EXTRN $ERC_FC:NEAR + + +Entries PROC FAR + +;** $FLDA - Field statement preamble +; +; ENTRY (BX) = file number + +$FLDA: MOV [$$SPSV],SP ;Record stack pointer + PUSH AX + PUSH SI + CALL $FBLOC ;Find FDB + JZ ercifn ; Not found + CMP [SI].FD_MODE,MD_RND + JNE ercbfm + + MOV AX,[SI].FR_VRECL + MOV [FIELD_LEFT],AX ;Save field length + ADD SI,FR_FIELD ;(SI) = field buffer address + MOV [FIELD_POS],SI ;Save address + POP SI + POP AX + RET + + + +;** $FLDB - Field assignment +; +; ENTRY (BX) = String descriptor +; (DX) = field length + +$FLDB: MOV [$$SPSV],SP + OR DX,DX + JS ercfc ;Can't have negative field length + PUSH AX + SUB [FIELD_LEFT],DX ;Count off current field + JB ercfov ; Too big + CALL $$FSS ;Free string space + MOV AX,[FIELD_POS] ;Get current field position + MOV [BX],DX ;Set new string length + MOV [BX+2],AX ;Set new string address + ADD [FIELD_POS],DX ;Bump to next field position + POP AX + RET + + +ercifn: JMP $ERC_IFN +ercbfm: JMP $ERC_BFM +ercfc: JMP $ERC_FC +ercfov: JMP $ERC_FOV + +Entries ENDP + +CODE ENDS + + END From 330111880b658760a9f92cc8627a6ae25d502079 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 27 Jun 2026 17:24:37 -0700 Subject: [PATCH 20/53] Transcription of Bundle 9 - FIN.ASM Code and Listing --- 2_printed_files/bundle_09/FIN.ASM | 660 ++++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/FIN.ASM | 448 ++++++++++++++++++++ 2 files changed, 1108 insertions(+) create mode 100644 2_printed_files/bundle_09/FIN.ASM create mode 100644 3_source_code/BASLIB-86/FIN.ASM diff --git a/2_printed_files/bundle_09/FIN.ASM b/2_printed_files/bundle_09/FIN.ASM new file mode 100644 index 0000000..b74979c --- /dev/null +++ b/2_printed_files/bundle_09/FIN.ASM @@ -0,0 +1,660 @@ +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-1 + + + + 1 TITLE FIN - String and numeric input + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN VALTYP:BYTE, CURTYP:BYTE, TYP:WORD, $AC:WORD, $FAC:BYTE + 6 EXTRN PWR10TAB:WORD, $DAC:WORD + 7 + 8 = 0080 FIX10 EQU 128 ;Correction to out-of-range exponents + 9 = 0026 HIGH10 EQU 38 ;Largest power of 10 with correct exponent + 10 = 0026 MAX10 EQU 38 ;Largest power of 10 that won't overflow + 11 = FFC9 MIN10 EQU -55 ;Smallest power of 10 that won't underflow + 12 + 13 0000 ???? PWRINC DW ? + 14 0002 ?? HAVDP DB ? + 15 + 16 0003 DATA ENDS + 17 + 18 DC GROUP DATA + 19 + 20 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 21 + 22 PUBLIC $FIN,$GETCH,$VAL + 23 + 24 EXTRN $CISA:FAR, $CSPB:FAR, $CINFAC:FAR, $OVFL:NEAR, $$CTS:NEAR + 25 EXTRN $SNORM:NEAR, $DNORM:NEAR, $SMUL:NEAR, $DMUL:NEAR + 26 EXTRN $SAVREG:NEAR, $$PUTZ:NEAR, $$DITS:NEAR + 27 EXTRN $SDIV:NEAR, $DDIV:NEAR + 28 + 29 ASSUME CS:CODE, DS:DC, ES:DC + 30 + 31 + 32 ;*** $VAL - VAL function + 33 ; + 34 ; Inputs: + 35 ; BX = Address of string descriptor + 36 ; Function: + 37 ; Compute numeric equivalent of the string + 38 ; Outputs: + 39 ; Double precision result in DAC + 40 ; Registers: + 41 ; Only F affected. + 42 + 43 0000 $VAL: + 44 0000 E8 0000 E CALL $SAVREG + 45 0003 E8 0000 E CALL $$PUTZ + 46 0006 C6 06 0000 E 08 MOV [VALTYP],8 ;Force to double precision + 47 000B 8B 77 02 MOV SI,[BX+2] ;Get address of string data + 48 000E 53 PUSH BX ;Save string descriptor address + 49 000F E8 008F R CALL $FIN + 50 0012 5B POP BX + 51 0013 E9 0000 E JMP $$DITS ;Delete if temp string + 52 + 53 + 54 0016 GETSTR: + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-2 + + + + 55 ;Come here to get string from input line (continuation of $FIN, below) + 56 0016 E8 026F R CALL $GETCH + 57 0019 8A E0 MOV AH,AL ;In case first char is " + 58 001B 3C 22 CMP AL,'"' ;Is it? + 59 001D 74 03 JZ COUNTSTR + 60 001F B4 2C MOV AH,"," ;Terminate with comma if not quoted + 61 0021 4E DEC SI ;Scan first char again + 62 0022 COUNTSTR: + 63 0022 8B D6 MOV DX,SI ;Save starting address of string data + 64 0024 33 C9 XOR CX,CX ;Character count + 65 0026 RDSTR: + 66 0026 AC LODSB + 67 0027 3A C4 CMP AL,AH ;End of string? + 68 0029 74 05 JZ NEGCNT + 69 002B 0A C0 OR AL,AL ;End of line? + 70 002D E0 F7 LOOPNZ RDSTR ;Count char and loop if not EOL + 71 002F 41 INC CX ;Don't count the EOL character + 72 0030 NEGCNT: + 73 0030 F7 D9 NEG CX ;Make character count positive + 74 0032 80 FC 2C CMP AH,',' ;Unquoted string? + 75 0035 75 0F JNZ MAKSTR + 76 ;Not a quoted string. Trim off trailing blanks. + 77 0037 4E DEC SI ;Point back at termination character + 78 0038 8B FE MOV DI,SI + 79 003A 4F DEC DI ;Point to last char of string + 80 003B B0 20 MOV AL," " + 81 003D 3A C0 CMP AL,AL ;Set zero flag in case CX=0 + 82 003F FD STD ;Set direction DOWN + 83 0040 F3/ AE REPE SCASB ;Scan of blanks backward + 84 0042 FC CLD ;Restore direction + 85 0043 74 01 JZ MAKSTR ;If null string, leave zero in CX + 86 0045 41 INC CX ;Last char scanned not blank - count it + 87 0046 MAKSTR: + 88 0046 8B D9 MOV BX,CX + 89 0048 E8 0000 E CALL $$CTS ;Create temp string + 90 004B 89 1E 0000 E MOV [$AC],BX ;Put address in AC for safekeeping + 91 004F C3 RET + 92 + 93 0050 HEXOCT: + 94 0050 C6 06 0000 E 02 MOV [CURTYP],2 ;Set type to integer + 95 0055 33 DB XOR BX,BX ;Initialize input to zero + 96 0057 E8 026F R CALL $GETCH ;"&" followed by "O" or "H"? + 97 005A B9 0F04 MOV CX,15*100H+4 ;Prepare for hex input + 98 005D 3C 48 CMP AL,"H" ;Is it "&H"? + 99 005F 74 07 JZ OCTHEX + 100 0061 B9 0703 MOV CX,7*100H+3 ;Prepare for octal input + 101 0064 3C 4F CMP AL,"O" ;Is it "&O"? + 102 0066 75 03 JNZ OCTHEX1 + 103 0068 OCTHEX: + 104 0068 E8 026F R CALL $GETCH ;Eat the "H" or "O" + 105 006B OCTHEX1: + 106 006B 2C 30 SUB AL,"0" ;Remove ASCII bias + 107 006D 72 1B JB LVHEX ;If not a hex digit, quit + 108 006F 3C 09 CMP AL,9 + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-3 + + + + 109 0071 76 06 JBE OK + 110 0073 2C 07 SUB AL,7 ;If "A" to "F", make 10-15 + 111 0075 3C 0A CMP AL,10 + 112 0077 72 11 JB LVHEX + 113 0079 OK: + 114 0079 3A C5 CMP AL,CH ;CH has max value (7 for oct, 15 for hex) + 115 007B 77 0D JA LVHEX + 116 007D F6 C7 E0 TEST BH,0E0H ;Highest 3 bits must be zero + 117 0080 75 4B JNZ OVERFLOW + 118 0082 D3 E3 SHL BX,CL ;Make room for new digit + 119 0084 72 47 JC OVERFLOW + 120 0086 0A D8 OR BL,AL ;Combine new digit + 121 0088 EB DE JMP OCTHEX + 122 008A LVHEX: + 123 008A 4E DEC SI ;Back up to non-digit + 124 008B 33 C9 XOR CX,CX ;No power of 10 + 125 008D EB 16 JMP SHORT SAVTYP + 126 + 127 + 128 ;*** $FIN - Floating point and string input + 129 ; + 130 ; Inputs: + 131 ; [VALTYP] = Type of value required + 132 ; SI = Address of character stream to analyze for the value + 133 ; Outputs: + 134 ; AC has integer value ([VALTYP] = 2) + 135 ; BX = Address of string descriptor ([VALTYP] = 3) + 136 ; AC has S.P. value ([VALTYP] = 4) + 137 ; DAC has D.P. value ([VALTYP] = 8) + 138 ; Registers: + 139 ; Uses all. + 140 + 141 008F $FIN: + 142 008F 80 3E 0000 E 03 CMP [VALTYP],3 ;Getting a string? + 143 0094 74 80 JZ GETSTR + 144 0096 E8 0198 R CALL SIGN + 145 0099 9C PUSHF ;Save sign in flags + 146 009A E8 026F R CALL $GETCH + 147 009D 3C 26 CMP AL,"&" ;Hex or octal input? + 148 009F 74 AF JZ HEXOCT + 149 00A1 4E DEC SI ;Back up + 150 00A2 E8 01C0 R CALL ASCNUM ;Get ASCII digits, convert to integer + 151 00A5 SAVTYP: + 152 00A5 A1 0000 E MOV AX,[TYP] ;Get current type and requested type + 153 00A8 80 FC 04 CMP AH,4 ;Test current type + 154 00AB 77 0B JA SAVEDP ;Is it already double precision? + 155 00AD 3A C4 CMP AL,AH ;Need to convert S.P. to D.P.? + 156 00AF 76 1F JBE SAVSP + 157 ;Convert S.P. to D.P. + 158 00B1 C6 06 0000 E 08 MOV [CURTYP],8 ;Record change in precision + 159 00B6 33 FF XOR DI,DI + 160 00B8 SAVEDP: + 161 00B8 9D POPF ;Get sign flag (zero=negative) + 162 00B9 51 PUSH CX ;Currently in DI:BP:BX:DX + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-4 + + + + 163 00BA 8B CB MOV CX,BX ;Get in DI:BX:CX:DX form + 164 00BC 8B DD MOV BX,BP + 165 00BE B8 C000 MOV AX,192*100H ;Set sign and exponent for positive integer + 166 00C1 75 02 JNZ DPNORM ;Is it positive or negative? + 167 00C3 B0 80 MOV AL,80H ;Negative! + 168 00C5 DPNORM: + 169 00C5 56 PUSH SI + 170 00C6 E8 0000 E CALL $DNORM ;Normalize and store in FAC + 171 00C9 5E POP SI + 172 00CA 59 POP CX + 173 00CB EB 0E JMP SHORT HAVNUM ;Go check for exponent + 174 + 175 00CD E9 0000 E OVERFLOW:JMP $OVFL + 176 + 177 00D0 SAVSP: + 178 00D0 9D POPF + 179 00D1 B8 A000 MOV AX,160*100H ;Sign and exponent for positive integer + 180 00D4 75 02 JNZ SPNORM ;Positive? + 181 00D6 B0 80 MOV AL,80H ;Force negative sign + 182 00D8 SPNORM: + 183 00D8 E8 0000 E CALL $SNORM ;Normalize and store in FAC + 184 + 185 00DB HAVNUM: + 186 + 187 ;Number is stored as integer in FAC with proper sign, CURTYP has its type, + 188 ;which is at least the precision requested by VALTYP. CX has current base 10 + 189 ;exponent. Now we scan for type character ("%", "!", "#") or exponent field. + 190 + 191 00DB E8 026F R CALL $GETCH ;Get last char again + 192 ;Ignore the special type symbols + 193 00DE 3C 25 CMP AL,"%" ;Integer? + 194 00E0 74 2C JZ MULEXP + 195 00E2 3C 23 CMP AL,"#" ;Double? + 196 00E4 74 28 JZ MULEXP + 197 00E6 3C 21 CMP AL,"!" ;Single? + 198 00E8 74 24 JZ MULEXP + 199 ;Check for exponent + 200 00EA 3C 44 CMP AL,"D" ;Get D.P. exponent? + 201 00EC 74 07 JZ GETEXP + 202 00EE 3C 45 CMP AL,"E" ;S.P. exponent? + 203 00F0 74 03 JZ GETEXP + 204 00F2 4E DEC SI ;If not recognized, ignore + 205 00F3 EB 19 JMP SHORT MULEXP + 206 + 207 00F5 GETEXP: + 208 00F5 E8 0198 R CALL SIGN ;Get sign, if any + 209 00F8 9C PUSHF ;Save it + 210 00F9 33 DB XOR BX,BX + 211 00FB C6 06 0002 R 01 MOV [HAVDP],1 ;Don't allow a decimal point + 212 0100 89 1E 0000 R MOV [PWRINC],BX ;Don't change CX + 213 0104 E8 01A9 R CALL GETINT ;Get integer in BX + 214 0107 9D POPF ;Recover sign + 215 0108 75 02 JNZ NONEG ;Positive? + 216 010A F7 DB NEG BX + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-5 + + + + 217 010C NONEG: + 218 010C 03 CB ADD CX,BX + 219 + 220 010E MULEXP: + 221 + 222 ;FAC has number as integer, CX has its power of 10. Use lookup table to find + 223 ;the double precision power of 10, and multiply or divide. Then coerce to lower + 224 ;precision, if necessary. + 225 + 226 010E E3 68 JCXZ COERCE ;No multiplication needed? + 227 0110 83 F9 26 CMP CX,MAX10 + 228 0113 7F B8 JG OVERFLOW ;Power of 10 too big? + 229 0115 83 F9 C9 CMP CX,MIN10 + 230 0118 7C 6F JL ZERO ;Too small? + 231 011A 56 PUSH SI ;Save pointer to text + 232 011B 8B F9 MOV DI,CX + 233 011D 0B FF OR DI,DI ;Is exponent negative? + 234 011F 79 02 JNS HAVMAG + 235 0121 F7 DF NEG DI ;Get magnitude of exponent + 236 0123 HAVMAG: + 237 0123 83 FF 26 CMP DI,HIGH10 ;Is power too large to be correct? + 238 0126 7E 05 JLE NOFIX + 239 0128 80 2E 0000 E 80 SUB [$FAC],FIX10 ;Adjust our exponent to account for it + 240 012D NOFIX: + 241 012D D1 E7 SHL DI,1 + 242 012F D1 E7 SHL DI,1 + 243 0131 D1 E7 SHL DI,1 ;Multiply by 8 for index into table + 244 0133 80 3E 0000 E 08 CMP [CURTYP],8 ;Presently double precision? + 245 0138 74 2A JZ DBLEXP ;If so, do double precision multiply/divide + 246 013A 81 C7 0004 E ADD DI,OFFSET DC:PWR10TAB+4 ;Point to S.P. version of constant + 247 013E BE 0000 E MOV SI,OFFSET DC:$AC + 248 0141 81 7D FE 8000 CMP WORD PTR[DI-2],8000H ; See if we need to round it + 249 0146 72 0E JB SNGLEXP + 250 0148 83 EE 04 SUB SI,4 ;Copy number to low half of $DAC + 251 014B 87 F7 XCHG SI,DI ;Set up to move + 252 014D A5 MOVSW + 253 014E A5 MOVSW + 254 014F 8B F7 MOV SI,DI ;OFFSET $AC + 255 0151 BF 0000 E MOV DI,OFFSET DC:$DAC + 256 0154 FF 05 INC WORD PTR[DI] ;Round up + 257 0156 SNGLEXP: + 258 0156 0B C9 OR CX,CX ;Is exponent positive or negative? + 259 0158 79 05 JNS SNGPOS + 260 015A E8 0000 E CALL $SDIV ;Divide by power of 10 if exponent negative + 261 015D EB 18 JMP SHORT MULDON + 262 015F SNGPOS: + 263 015F E8 0000 E CALL $SMUL ;Multiply by power of 10 if exponent positive + 264 0162 EB 13 JMP SHORT MULDON + 265 + 266 0164 DBLEXP: + 267 0164 81 C7 0000 E ADD DI,OFFSET DC:PWR10TAB + 268 0168 BE 0000 E MOV SI,OFFSET DC:$DAC + 269 016B 0B C9 OR CX,CX + 270 016D 79 05 JNS DBLPOS + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-6 + + + + 271 016F E8 0000 E CALL $DDIV + 272 0172 EB 03 JMP SHORT MULDON + 273 0174 DBLPOS: + 274 0174 E8 0000 E CALL $DMUL + 275 0177 MULDON: + 276 0177 5E POP SI ;Recover pointer to text buffer + 277 0178 COERCE: + 278 0178 A1 0000 E MOV AX,[TYP] + 279 017B 3A C4 CMP AL,AH ;Already the right type? + 280 017D 74 26 JZ DONE + 281 017F 3C 02 CMP AL,2 ;Need integer? (have floating) + 282 0181 74 0F JZ CONVINT ;Convert to integer whether SP or DP + 283 0183 9A 0000 ---- E CALL $CSPB ;Convert DP to SP + 284 0188 C3 RET + 285 + 286 0189 ZERO: + 287 0189 33 C0 XOR AX,AX + 288 018B A3 0000 E MOV [$AC],AX ;Zero in case its integer + 289 018E A2 0000 E MOV [$FAC],AL ;Zero in case its floating + 290 0191 C3 RET + 291 + 292 0192 CONVINT: + 293 0192 9A 0000 ---- E CALL $CINFAC ;Convert floating to integer + 294 0197 C3 RET + 295 + 296 0198 SIGN: + 297 0198 E8 026F R CALL $GETCH + 298 019B 3C 2D CMP AL,"-" ;Negative? + 299 019D 74 06 JZ DONE + 300 019F 3C 2B CMP AL,"+" + 301 01A1 75 01 JNZ NOTZER + 302 01A3 46 INC SI ;Eat sign if present and + 303 01A4 4E NOTZER: DEC SI ;Back up and clear zero flag + 304 01A5 C3 DONE: RET + 305 + 306 01A6 MAXINT: + 307 01A6 BB 7FFF MOV BX,32767 ;Force maximum integer (will overflow later) + 308 01A9 GETINT: + 309 01A9 E8 0248 R CALL GETDIG + 310 01AC 81 FB 0CCC CMP BX,3276 + 311 01B0 77 F4 JA MAXINT + 312 01B2 D1 E3 SHL BX,1 + 313 01B4 03 C3 ADD AX,BX + 314 01B6 D1 E3 SHL BX,1 + 315 01B8 D1 E3 SHL BX,1 + 316 01BA 03 D8 ADD BX,AX ;BX = BX*10 + AX + 317 01BC 78 E8 JS MAXINT ;Still OK as signed integer? + 318 01BE EB E9 JMP GETINT + 319 + 320 01C0 ASCNUM: + 321 ;Scan a string of ASCII digits with optional decimal point and return + 322 ;32-, or 64-bit integer in registers. On exit: + 323 ; 32-bit result: BX:DX CURTYP = 4 + 324 ; 64-bit result: DI:BP:BX:DX CURTYP = 8 + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-7 + + + + 325 ; CX has power of 10 needed to put decimal point in right place. + 326 ; + 327 ;Sliding precision is used for speed. As the number of digits increases, + 328 ;requiring greater precision to maintain accuracy, the conversion shifts + 329 ;from to 32-bit to 64-bit calculations. If the number of digits + 330 ;exceeds 64-bit precision, these trailing digits are used to set a sticky + 331 ;bit (if non-zero), but are otherwise trimmed off. + 332 + 333 01C0 33 DB XOR BX,BX ;Current value is zero + 334 01C2 8B D3 MOV DX,BX + 335 01C4 8B EB MOV BP,BX + 336 01C6 8B CB MOV CX,BX ;No power of 10 yet + 337 01C8 89 1E 0000 R MOV [PWRINC],BX ;Don't increment power of 10 yet + 338 01CC C6 06 0000 E 04 MOV [CURTYP],4 ;Type integer so far + 339 01D1 88 1E 0002 R MOV [HAVDP],BL ;Decimal point not seen yet + 340 01D5 SNGLOOP: + 341 01D5 E8 0248 R CALL GETDIG + 342 01D8 D1 E2 SHL DX,1 + 343 01DA D1 D3 RCL BX,1 + 344 01DC 03 C2 ADD AX,DX + 345 01DE 8B FB MOV DI,BX + 346 01E0 83 D7 00 ADC DI,0 ;DI:AX = BX:DX*2 + AX + 347 01E3 D1 E2 SHL DX,1 + 348 01E5 D1 D3 RCL BX,1 + 349 01E7 D1 E2 SHL DX,1 + 350 01E9 D1 D3 RCL BX,1 + 351 01EB 03 D0 ADD DX,AX + 352 01ED 13 DF ADC BX,DI ;BX:DX = BX:DX*10 + AX + 353 01EF 0A FF OR BH,BH ;Still in 24 bits? + 354 01F1 74 E2 JZ SNGLOOP ;If not, convert to double + 355 01F3 C6 06 0000 E 08 MOV [CURTYP],8 ;Type now double precision + 356 01F8 33 FF XOR DI,DI ;Number in DI:BP:BX:DX + 357 01FA DBLLOOP: + 358 01FA E8 0248 R CALL GETDIG + 359 01FD 50 PUSH AX + 360 01FE 57 PUSH DI + 361 01FF 55 PUSH BP + 362 0200 53 PUSH BX + 363 0201 52 PUSH DX + 364 0202 D1 E2 SHL DX,1 ;Number=number*2 + 365 0204 D1 D3 RCL BX,1 + 366 0206 D1 D5 RCL BP,1 + 367 0208 D1 D7 RCL DI,1 + 368 020A D1 E2 SHL DX,1 ;Number=number*4 + 369 020C D1 D3 RCL BX,1 + 370 020E D1 D5 RCL BP,1 + 371 0210 D1 D7 RCL DI,1 + 372 0212 58 POP AX + 373 0213 03 D0 ADD DX,AX ;Number=number*5 + 374 0215 58 POP AX + 375 0216 13 D8 ADC BX,AX + 376 0218 58 POP AX + 377 0219 13 E8 ADC BP,AX + 378 021B 58 POP AX + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-8 + + + + 379 021C 13 F8 ADC DI,AX + 380 021E D1 E2 SHL DX,1 ;Number=number*10 + 381 0220 D1 D3 RCL BX,1 + 382 0222 D1 D5 RCL BP,1 + 383 0224 D1 D7 RCL DI,1 + 384 0226 58 POP AX ;New digit to add in + 385 0227 03 D0 ADD DX,AX + 386 0229 83 D3 00 ADC BX,0 + 387 022C 83 D5 00 ADC BP,0 + 388 022F 83 D7 00 ADC DI,0 + 389 0232 81 FF 1999 CMP DI,6553 ;If too many digits, ignore them + 390 0236 72 C2 JB DBLLOOP + 391 0238 FF 06 0000 R INC [PWRINC] ;Count the digits as we ignore them + 392 023C EATLOOP: + 393 023C E8 0248 R CALL GETDIG + 394 023F 0A C0 OR AL,AL ;Was digit zero? + 395 0241 74 03 JZ NEXTDIG + 396 0243 80 CA 01 OR DL,1 ;Set sticky bit if non-zero digit + 397 0246 NEXTDIG: + 398 0246 EB F4 JMP EATLOOP + 399 + 400 0248 GETDIG: + 401 ;This routine get the next digit and returns it (with ASCII bias removed) + 402 ;in AX (AH is always zero). For each digit returned, [PWRINC] is added to + 403 ;CX as a means to count digits so we'll get the power of 10 right. When the + 404 ;first decimal point is encountered, PWRINC is decremented one. This decimal + 405 ;point is skipped over and we look for the next digit. On return, the flags + 406 ;are set from a comparison with the largest number that can be multiplied by + 407 ;10 and not overflow BX. + 408 ; Should a second decimal point or any other non-digit be encountered, + 409 ;we have reached the end of the number and the routine pops one return + 410 ;address off the stack and returns to the next level up. + 411 0248 E8 026F R CALL $GETCH ;Get next ASCII character + 412 024B 2C 30 SUB AL,"0" ;Subtract ASCII bias + 413 024D 72 0A JB NOTNUM + 414 024F 3C 09 CMP AL,9 + 415 0251 77 06 JA NOTNUM + 416 0253 98 CBW ;Zero AH + 417 0254 03 0E 0000 R ADD CX,[PWRINC] ;Count digits ignored or to right of dec. pt. + 418 0258 C3 RET ;Return with flags set + 419 0259 NOTNUM: + 420 0259 3C FE CMP AL,"."-"0" ;Is it decimal point? + 421 025B 75 0D JNZ NOTDIG + 422 025D 80 3E 0002 R 00 CMP [HAVDP],0 ;Seen a dec.pt. before? + 423 0262 75 06 JNZ NOTDIG ;If so, this one ends the number + 424 0264 FF 0E 0000 R DEC [PWRINC] ;Count digits to right of dec.pt. + 425 0268 EB DE JMP GETDIG ;Get a real digit + 426 026A NOTDIG: + 427 026A 4E DEC SI ;Point back at non-digit + 428 026B 83 C4 02 ADD SP,2 ;Return to next level up + 429 026E C3 RET + 430 + 431 026F $GETCH: + 432 ;Get next byte, skipping blanks, tabs, and linefeeds + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Page 1-9 + + + + 433 026F AC LODSB ;Get next input byte + 434 0270 3C 20 CMP AL," " ;Ignore spaces + 435 0272 74 FB JZ $GETCH + 436 0274 3C 09 CMP AL,9 ;Ignore tabs + 437 0276 74 F7 JZ $GETCH + 438 0278 3C 0A CMP AL,10 ;Ignore linefeeds + 439 027A 74 F3 JZ $GETCH + 440 027C 3C 61 CMP AL,"a" + 441 027E 72 06 JB RET + 442 0280 3C 7A CMP AL,"z" + 443 0282 77 02 JA RET + 444 0284 24 5F AND AL,5FH ;Convert lower to upper case + 445 0286 C3 RET: RET + 446 + 447 0287 CODE ENDS + 448 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0287 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0003 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ASCNUM . . . . . . . . . . . . . L NEAR 01C0 CODE +COERCE . . . . . . . . . . . . . L NEAR 0178 CODE +CONVINT. . . . . . . . . . . . . L NEAR 0192 CODE +COUNTSTR . . . . . . . . . . . . L NEAR 0022 CODE +CURTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +DBLEXP . . . . . . . . . . . . . L NEAR 0164 CODE +DBLLOOP. . . . . . . . . . . . . L NEAR 01FA CODE +DBLPOS . . . . . . . . . . . . . L NEAR 0174 CODE +DONE . . . . . . . . . . . . . . L NEAR 01A5 CODE +DPNORM . . . . . . . . . . . . . L NEAR 00C5 CODE +EATLOOP. . . . . . . . . . . . . L NEAR 023C CODE +FIX10. . . . . . . . . . . . . . Number 0080 +GETDIG . . . . . . . . . . . . . L NEAR 0248 CODE +GETEXP . . . . . . . . . . . . . L NEAR 00F5 CODE +GETINT . . . . . . . . . . . . . L NEAR 01A9 CODE +GETSTR . . . . . . . . . . . . . L NEAR 0016 CODE +HAVDP. . . . . . . . . . . . . . L BYTE 0002 DATA +HAVMAG . . . . . . . . . . . . . L NEAR 0123 CODE +HAVNUM . . . . . . . . . . . . . L NEAR 00DB CODE +HEXOCT . . . . . . . . . . . . . L NEAR 0050 CODE +HIGH10 . . . . . . . . . . . . . Number 0026 +LVHEX. . . . . . . . . . . . . . L NEAR 008A CODE +MAKSTR . . . . . . . . . . . . . L NEAR 0046 CODE +MAX10. . . . . . . . . . . . . . Number 0026 +MAXINT . . . . . . . . . . . . . L NEAR 01A6 CODE +MIN10. . . . . . . . . . . . . . Number FFC9 +MULDON . . . . . . . . . . . . . L NEAR 0177 CODE +MULEXP . . . . . . . . . . . . . L NEAR 010E CODE +NEGCNT . . . . . . . . . . . . . L NEAR 0030 CODE +NEXTDIG. . . . . . . . . . . . . L NEAR 0246 CODE +NOFIX. . . . . . . . . . . . . . L NEAR 012D CODE +NONEG. . . . . . . . . . . . . . L NEAR 010C CODE +NOTDIG . . . . . . . . . . . . . L NEAR 026A CODE +NOTNUM . . . . . . . . . . . . . L NEAR 0259 CODE +NOTZER . . . . . . . . . . . . . L NEAR 01A4 CODE +OCTHEX . . . . . . . . . . . . . L NEAR 0068 CODE +OCTHEX1. . . . . . . . . . . . . L NEAR 006B CODE +OK . . . . . . . . . . . . . . . L NEAR 0079 CODE +OVERFLOW . . . . . . . . . . . . L NEAR 00CD CODE +PWR10TAB . . . . . . . . . . . . V WORD 0000 DATA External +PWRINC . . . . . . . . . . . . . L WORD 0000 DATA +RDSTR. . . . . . . . . . . . . . L NEAR 0026 CODE + + +FIN - String and numeric input Macro-86 %1(12) 1:1:14 13-Nov-81 Symbols-2 + + + +RET. . . . . . . . . . . . . . . L NEAR 0286 CODE +SAVEDP . . . . . . . . . . . . . L NEAR 00B8 CODE +SAVSP. . . . . . . . . . . . . . L NEAR 00D0 CODE +SAVTYP . . . . . . . . . . . . . L NEAR 00A5 CODE +SIGN . . . . . . . . . . . . . . L NEAR 0198 CODE +SNGLEXP. . . . . . . . . . . . . L NEAR 0156 CODE +SNGLOOP. . . . . . . . . . . . . L NEAR 01D5 CODE +SNGPOS . . . . . . . . . . . . . L NEAR 015F CODE +SPNORM . . . . . . . . . . . . . L NEAR 00D8 CODE +TYP. . . . . . . . . . . . . . . V WORD 0000 DATA External +VALTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +ZERO . . . . . . . . . . . . . . L NEAR 0189 CODE +$$CTS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External +$$PUTZ . . . . . . . . . . . . . L NEAR 0000 CODE External +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$CINFAC. . . . . . . . . . . . . L FAR 0000 CODE External +$CISA. . . . . . . . . . . . . . L FAR 0000 CODE External +$CSPB. . . . . . . . . . . . . . L FAR 0000 CODE External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DNORM . . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FIN . . . . . . . . . . . . . . L NEAR 008F CODE Global +$GETCH . . . . . . . . . . . . . L NEAR 026F CODE Global +$OVFL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SNORM . . . . . . . . . . . . . L NEAR 0000 CODE External +$VAL . . . . . . . . . . . . . . L NEAR 0000 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/FIN.ASM b/3_source_code/BASLIB-86/FIN.ASM new file mode 100644 index 0000000..b4d7ddf --- /dev/null +++ b/3_source_code/BASLIB-86/FIN.ASM @@ -0,0 +1,448 @@ + TITLE FIN - String and numeric input + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN VALTYP:BYTE, CURTYP:BYTE, TYP:WORD, $AC:WORD, $FAC:BYTE + EXTRN PWR10TAB:WORD, $DAC:WORD + +FIX10 EQU 128 ;Correction to out-of-range exponents +HIGH10 EQU 38 ;Largest power of 10 with correct exponent +MAX10 EQU 38 ;Largest power of 10 that won't overflow +MIN10 EQU -55 ;Smallest power of 10 that won't underflow + +PWRINC DW ? +HAVDP DB ? + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FIN,$GETCH,$VAL + + EXTRN $CISA:FAR, $CSPB:FAR, $CINFAC:FAR, $OVFL:NEAR, $$CTS:NEAR + EXTRN $SNORM:NEAR, $DNORM:NEAR, $SMUL:NEAR, $DMUL:NEAR + EXTRN $SAVREG:NEAR, $$PUTZ:NEAR, $$DITS:NEAR + EXTRN $SDIV:NEAR, $DDIV:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $VAL - VAL function +; +; Inputs: +; BX = Address of string descriptor +; Function: +; Compute numeric equivalent of the string +; Outputs: +; Double precision result in DAC +; Registers: +; Only F affected. + +$VAL: + CALL $SAVREG + CALL $$PUTZ + MOV [VALTYP],8 ;Force to double precision + MOV SI,[BX+2] ;Get address of string data + PUSH BX ;Save string descriptor address + CALL $FIN + POP BX + JMP $$DITS ;Delete if temp string + + +GETSTR: +;Come here to get string from input line (continuation of $FIN, below) + CALL $GETCH + MOV AH,AL ;In case first char is " + CMP AL,'"' ;Is it? + JZ COUNTSTR + MOV AH,"," ;Terminate with comma if not quoted + DEC SI ;Scan first char again +COUNTSTR: + MOV DX,SI ;Save starting address of string data + XOR CX,CX ;Character count +RDSTR: + LODSB + CMP AL,AH ;End of string? + JZ NEGCNT + OR AL,AL ;End of line? + LOOPNZ RDSTR ;Count char and loop if not EOL + INC CX ;Don't count the EOL character +NEGCNT: + NEG CX ;Make character count positive + CMP AH,',' ;Unquoted string? + JNZ MAKSTR +;Not a quoted string. Trim off trailing blanks. + DEC SI ;Point back at termination character + MOV DI,SI + DEC DI ;Point to last char of string + MOV AL," " + CMP AL,AL ;Set zero flag in case CX=0 + STD ;Set direction DOWN + REPE SCASB ;Scan of blanks backward + CLD ;Restore direction + JZ MAKSTR ;If null string, leave zero in CX + INC CX ;Last char scanned not blank - count it +MAKSTR: + MOV BX,CX + CALL $$CTS ;Create temp string + MOV [$AC],BX ;Put address in AC for safekeeping + RET + +HEXOCT: + MOV [CURTYP],2 ;Set type to integer + XOR BX,BX ;Initialize input to zero + CALL $GETCH ;"&" followed by "O" or "H"? + MOV CX,15*100H+4 ;Prepare for hex input + CMP AL,"H" ;Is it "&H"? + JZ OCTHEX + MOV CX,7*100H+3 ;Prepare for octal input + CMP AL,"O" ;Is it "&O"? + JNZ OCTHEX1 +OCTHEX: + CALL $GETCH ;Eat the "H" or "O" +OCTHEX1: + SUB AL,"0" ;Remove ASCII bias + JB LVHEX ;If not a hex digit, quit + CMP AL,9 + JBE OK + SUB AL,7 ;If "A" to "F", make 10-15 + CMP AL,10 + JB LVHEX +OK: + CMP AL,CH ;CH has max value (7 for oct, 15 for hex) + JA LVHEX + TEST BH,0E0H ;Highest 3 bits must be zero + JNZ OVERFLOW + SHL BX,CL ;Make room for new digit + JC OVERFLOW + OR BL,AL ;Combine new digit + JMP OCTHEX +LVHEX: + DEC SI ;Back up to non-digit + XOR CX,CX ;No power of 10 + JMP SHORT SAVTYP + + +;*** $FIN - Floating point and string input +; +; Inputs: +; [VALTYP] = Type of value required +; SI = Address of character stream to analyze for the value +; Outputs: +; AC has integer value ([VALTYP] = 2) +; BX = Address of string descriptor ([VALTYP] = 3) +; AC has S.P. value ([VALTYP] = 4) +; DAC has D.P. value ([VALTYP] = 8) +; Registers: +; Uses all. + +$FIN: + CMP [VALTYP],3 ;Getting a string? + JZ GETSTR + CALL SIGN + PUSHF ;Save sign in flags + CALL $GETCH + CMP AL,"&" ;Hex or octal input? + JZ HEXOCT + DEC SI ;Back up + CALL ASCNUM ;Get ASCII digits, convert to integer +SAVTYP: + MOV AX,[TYP] ;Get current type and requested type + CMP AH,4 ;Test current type + JA SAVEDP ;Is it already double precision? + CMP AL,AH ;Need to convert S.P. to D.P.? + JBE SAVSP +;Convert S.P. to D.P. + MOV [CURTYP],8 ;Record change in precision + XOR DI,DI +SAVEDP: + POPF ;Get sign flag (zero=negative) + PUSH CX ;Currently in DI:BP:BX:DX + MOV CX,BX ;Get in DI:BX:CX:DX form + MOV BX,BP + MOV AX,192*100H ;Set sign and exponent for positive integer + JNZ DPNORM ;Is it positive or negative? + MOV AL,80H ;Negative! +DPNORM: + PUSH SI + CALL $DNORM ;Normalize and store in FAC + POP SI + POP CX + JMP SHORT HAVNUM ;Go check for exponent + +OVERFLOW:JMP $OVFL + +SAVSP: + POPF + MOV AX,160*100H ;Sign and exponent for positive integer + JNZ SPNORM ;Positive? + MOV AL,80H ;Force negative sign +SPNORM: + CALL $SNORM ;Normalize and store in FAC + +HAVNUM: + +;Number is stored as integer in FAC with proper sign, CURTYP has its type, +;which is at least the precision requested by VALTYP. CX has current base 10 +;exponent. Now we scan for type character ("%", "!", "#") or exponent field. + + CALL $GETCH ;Get last char again +;Ignore the special type symbols + CMP AL,"%" ;Integer? + JZ MULEXP + CMP AL,"#" ;Double? + JZ MULEXP + CMP AL,"!" ;Single? + JZ MULEXP +;Check for exponent + CMP AL,"D" ;Get D.P. exponent? + JZ GETEXP + CMP AL,"E" ;S.P. exponent? + JZ GETEXP + DEC SI ;If not recognized, ignore + JMP SHORT MULEXP + +GETEXP: + CALL SIGN ;Get sign, if any + PUSHF ;Save it + XOR BX,BX + MOV [HAVDP],1 ;Don't allow a decimal point + MOV [PWRINC],BX ;Don't change CX + CALL GETINT ;Get integer in BX + POPF ;Recover sign + JNZ NONEG ;Positive? + NEG BX +NONEG: + ADD CX,BX + +MULEXP: + +;FAC has number as integer, CX has its power of 10. Use lookup table to find +;the double precision power of 10, and multiply or divide. Then coerce to lower +;precision, if necessary. + + JCXZ COERCE ;No multiplication needed? + CMP CX,MAX10 + JG OVERFLOW ;Power of 10 too big? + CMP CX,MIN10 + JL ZERO ;Too small? + PUSH SI ;Save pointer to text + MOV DI,CX + OR DI,DI ;Is exponent negative? + JNS HAVMAG + NEG DI ;Get magnitude of exponent +HAVMAG: + CMP DI,HIGH10 ;Is power too large to be correct? + JLE NOFIX + SUB [$FAC],FIX10 ;Adjust our exponent to account for it +NOFIX: + SHL DI,1 + SHL DI,1 + SHL DI,1 ;Multiply by 8 for index into table + CMP [CURTYP],8 ;Presently double precision? + JZ DBLEXP ;If so, do double precision multiply/divide + ADD DI,OFFSET DC:PWR10TAB+4 ;Point to S.P. version of constant + MOV SI,OFFSET DC:$AC + CMP WORD PTR[DI-2],8000H ;See if we need to round it + JB SNGLEXP + SUB SI,4 ;Copy number to low half of $DAC + XCHG SI,DI ;Set up to move + MOVSW + MOVSW + MOV SI,DI ;OFFSET $AC + MOV DI,OFFSET DC:$DAC + INC WORD PTR[DI] ;Round up +SNGLEXP: + OR CX,CX ;Is exponent positive or negative? + JNS SNGPOS + CALL $SDIV ;Divide by power of 10 if exponent negative + JMP SHORT MULDON +SNGPOS: + CALL $SMUL ;Multiply by power of 10 if exponent positive + JMP SHORT MULDON + +DBLEXP: + ADD DI,OFFSET DC:PWR10TAB + MOV SI,OFFSET DC:$DAC + OR CX,CX + JNS DBLPOS + CALL $DDIV + JMP SHORT MULDON +DBLPOS: + CALL $DMUL +MULDON: + POP SI ;Recover pointer to text buffer +COERCE: + MOV AX,[TYP] + CMP AL,AH ;Already the right type? + JZ DONE + CMP AL,2 ;Need integer? (have floating) + JZ CONVINT ;Convert to integer whether SP or DP + CALL $CSPB ;Convert DP to SP + RET + +ZERO: + XOR AX,AX + MOV [$AC],AX ;Zero in case its integer + MOV [$FAC],AL ;Zero in case its floating + RET + +CONVINT: + CALL $CINFAC ;Convert floating to integer + RET + +SIGN: + CALL $GETCH + CMP AL,"-" ;Negative? + JZ DONE + CMP AL,"+" + JNZ NOTZER + INC SI ;Eat sign if present and +NOTZER: DEC SI ;Back up and clear zero flag +DONE: RET + +MAXINT: + MOV BX,32767 ;Force maximum integer (will overflow later) +GETINT: + CALL GETDIG + CMP BX,3276 + JA MAXINT + SHL BX,1 + ADD AX,BX + SHL BX,1 + SHL BX,1 + ADD BX,AX ;BX = BX*10 + AX + JS MAXINT ;Still OK as signed integer? + JMP GETINT + +ASCNUM: +;Scan a string of ASCII digits with optional decimal point and return +;32-, or 64-bit integer in registers. On exit: +; 32-bit result: BX:DX CURTYP = 4 +; 64-bit result: DI:BP:BX:DX CURTYP = 8 +; CX has power of 10 needed to put decimal point in right place. +; +;Sliding precision is used for speed. As the number of digits increases, +;requiring greater precision to maintain accuracy, the conversion shifts +;from to 32-bit to 64-bit calculations. If the number of digits +;exceeds 64-bit precision, these trailing digits are used to set a sticky +;bit (if non-zero), but are otherwise trimmed off. + + XOR BX,BX ;Current value is zero + MOV DX,BX + MOV BP,BX + MOV CX,BX ;No power of 10 yet + MOV [PWRINC],BX ;Don't increment power of 10 yet + MOV [CURTYP],4 ;Type integer so far + MOV [HAVDP],BL ;Decimal point not seen yet +SNGLOOP: + CALL GETDIG + SHL DX,1 + RCL BX,1 + ADD AX,DX + MOV DI,BX + ADC DI,0 ;DI:AX = BX:DX*2 + AX + SHL DX,1 + RCL BX,1 + SHL DX,1 + RCL BX,1 + ADD DX,AX + ADC BX,DI ;BX:DX = BX:DX*10 + AX + OR BH,BH ;Still in 24 bits? + JZ SNGLOOP ;If not, convert to double + MOV [CURTYP],8 ;Type now double precision + XOR DI,DI ;Number in DI:BP:BX:DX +DBLLOOP: + CALL GETDIG + PUSH AX + PUSH DI + PUSH BP + PUSH BX + PUSH DX + SHL DX,1 ;Number=number*2 + RCL BX,1 + RCL BP,1 + RCL DI,1 + SHL DX,1 ;Number=number*4 + RCL BX,1 + RCL BP,1 + RCL DI,1 + POP AX + ADD DX,AX ;Number=number*5 + POP AX + ADC BX,AX + POP AX + ADC BP,AX + POP AX + ADC DI,AX + SHL DX,1 ;Number=number*10 + RCL BX,1 + RCL BP,1 + RCL DI,1 + POP AX ;New digit to add in + ADD DX,AX + ADC BX,0 + ADC BP,0 + ADC DI,0 + CMP DI,6553 ;If too many digits, ignore them + JB DBLLOOP + INC [PWRINC] ;Count the digits as we ignore them +EATLOOP: + CALL GETDIG + OR AL,AL ;Was digit zero? + JZ NEXTDIG + OR DL,1 ;Set sticky bit if non-zero digit +NEXTDIG: + JMP EATLOOP + +GETDIG: +;This routine get the next digit and returns it (with ASCII bias removed) +;in AX (AH is always zero). For each digit returned, [PWRINC] is added to +;CX as a means to count digits so we'll get the power of 10 right. When the +;first decimal point is encountered, PWRINC is decremented one. This decimal +;point is skipped over and we look for the next digit. On return, the flags +;are set from a comparison with the largest number that can be multiplied by +;10 and not overflow BX. +; Should a second decimal point or any other non-digit be encountered, +;we have reached the end of the number and the routine pops one return +;address off the stack and returns to the next level up. + CALL $GETCH ;Get next ASCII character + SUB AL,"0" ;Subtract ASCII bias + JB NOTNUM + CMP AL,9 + JA NOTNUM + CBW ;Zero AH + ADD CX,[PWRINC] ;Count digits ignored or to right of dec. pt. + RET ;Return with flags set +NOTNUM: + CMP AL,"."-"0" ;Is it decimal point? + JNZ NOTDIG + CMP [HAVDP],0 ;Seen a dec.pt. before? + JNZ NOTDIG ;If so, this one ends the number + DEC [PWRINC] ;Count digits to right of dec.pt. + JMP GETDIG ;Get a real digit +NOTDIG: + DEC SI ;Point back at non-digit + ADD SP,2 ;Return to next level up + RET + +$GETCH: +;Get next byte, skipping blanks, tabs, and linefeeds + LODSB ;Get next input byte + CMP AL," " ;Ignore spaces + JZ $GETCH + CMP AL,9 ;Ignore tabs + JZ $GETCH + CMP AL,10 ;Ignore linefeeds + JZ $GETCH + CMP AL,"a" + JB RET + CMP AL,"z" + JA RET + AND AL,5FH ;Convert lower to upper case +RET: RET + +CODE ENDS + END From f00df948237cc041e044ea10e9e819ea28bfec3b Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sun, 28 Jun 2026 18:03:59 -0700 Subject: [PATCH 21/53] Transcription of Bundle 9 - FLOAT.ASM Code and Listing --- 2_printed_files/bundle_09/FLOAT.ASM | 240 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/FLOAT.ASM | 157 ++++++++++++++++++ 2 files changed, 397 insertions(+) create mode 100644 2_printed_files/bundle_09/FLOAT.ASM create mode 100644 3_source_code/BASLIB-86/FLOAT.ASM diff --git a/2_printed_files/bundle_09/FLOAT.ASM b/2_printed_files/bundle_09/FLOAT.ASM new file mode 100644 index 0000000..21e0edd --- /dev/null +++ b/2_printed_files/bundle_09/FLOAT.ASM @@ -0,0 +1,240 @@ +FLOAT - Floating point entry points Macro-86 %1(12) 1:1:30 13-Nov-81 Page 1-1 + + + + 1 TITLE FLOAT - Floating point entry points + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $AC:WORD, $DAC:WORD, $FT:WORD, $$SPSV:WORD + 6 + 7 0000 ???? SISAVE DW ? + 8 0002 ???? DISAVE DW ? + 9 0004 ???? POINTER DW ? + 10 + 11 0006 DATA ENDS + 12 + 13 DC GROUP DATA + 14 + 15 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 16 + 17 PUBLIC $FASA, $FASB, $FASC, $FASD + 18 PUBLIC $STFA, $STFB, $LDFA, $LDFB + 19 PUBLIC $SAVREG, $GTMP + 20 + 21 ASSUME CS:CODE, DS:DC, ES:DC + 22 + 23 + 24 ; Floating point assignment + 25 + 26 0000 FLTASS PROC FAR ;Set up long returns + 27 + 28 ; $FASA - Assign [SI] to [DI], single precision + 29 ; $FASB - Assign [SI] to [DI], double precision + 30 ; $FASC - Assign FAC to [DI], single precision + 31 ; $FASD - Assign FAC to [DI], double precision + 32 ; $STFA - Store FAC in temp, SP + 33 ; $STFB - Store FAC in temp, DP + 34 ; $LDFA - Load FAC from [SI], SP + 35 ; $LDFB - Load FAC from [SI], DP + 36 + 37 0000 $FASC: + 38 0000 BE 0000 E MOV SI,OFFSET DC:$AC + 39 0003 $FASA: + 40 0003 A5 MOVSW + 41 0004 A5 MOVSW + 42 0005 83 EF 04 SUB DI,4 + 43 0008 83 EE 04 SUB SI,4 + 44 000B CB RET + 45 + 46 000C $FASD: + 47 000C BE 0000 E MOV SI,OFFSET DC:$DAC + 48 000F $FASB: + 49 000F A5 MOVSW + 50 0010 A5 MOVSW + 51 0011 A5 MOVSW + 52 0012 A5 MOVSW + 53 0013 83 EF 08 SUB DI,8 + 54 0016 83 EE 08 SUB SI,8 + + +FLOAT - Floating point entry points Macro-86 %1(12) 1:1:30 13-Nov-81 Page 1-2 + + + + 55 0019 CB RET + 56 + 57 001A $LDFA: + 58 001A BF 0000 E MOV DI,OFFSET DC:$AC + 59 001D A5 MOVSW + 60 001E A5 MOVSW + 61 001F 83 EE 04 SUB SI,4 + 62 0022 CB RET + 63 + 64 0023 $LDFB: + 65 0023 BF 0000 E MOV DI,OFFSET DC:$DAC + 66 0026 A5 MOVSW + 67 0027 A5 MOVSW + 68 0028 A5 MOVSW + 69 0029 A5 MOVSW + 70 002A 83 EE 08 SUB SI,8 + 71 002D CB RET + 72 + 73 002E $STFA: + 74 002E 89 36 0000 R MOV [SISAVE],SI + 75 0032 89 3E 0002 R MOV [DISAVE],DI + 76 0036 E8 0062 R CALL $GTMP + 77 0039 BE 0000 E MOV SI,OFFSET DC:$AC + 78 003C A5 MOVSW + 79 003D A5 MOVSW + 80 003E 8B 36 0000 R MOV SI,[SISAVE] + 81 0042 8B 3E 0002 R MOV DI,[DISAVE] + 82 0046 CB RET + 83 + 84 0047 $STFB: + 85 0047 89 36 0000 R MOV [SISAVE],SI + 86 004B 89 3E 0002 R MOV [DISAVE],DI + 87 004F E8 0062 R CALL $GTMP + 88 0052 BE 0000 E MOV SI,OFFSET DC:$DAC + 89 0055 A5 MOVSW + 90 0056 A5 MOVSW + 91 0057 A5 MOVSW + 92 0058 A5 MOVSW + 93 0059 8B 36 0000 R MOV SI,[SISAVE] + 94 005D 8B 3E 0002 R MOV DI,[DISAVE] + 95 0061 CB RET + 96 + 97 0062 FLTASS ENDP + 98 + 99 0062 $GTMP: + 100 + 101 ; Inputs: + 102 ; Long return address one level deep on stack points to temp number. + 103 ; Function: + 104 ; Get address of temp. + 105 ; Outputs: + 106 ; SI = DI = Address of floating temp. + 107 ; Registers: + 108 ; Only SI, DI and F affected. + + +FLOAT - Floating point entry points Macro-86 %1(12) 1:1:30 13-Nov-81 Page 1-3 + + + + 109 + 110 0062 8F 06 0004 R POP [POINTER] + 111 0066 5E POP SI + 112 0067 1F POP DS + 113 0068 97 XCHG AX,DI + 114 0069 AC LODSB ;Get temp number + 115 006A D0 E0 SHL AL,1 + 116 006C B4 00 MOV AH,0 + 117 006E D1 E0 SHL AX,1 + 118 0070 D1 E0 SHL AX,1 + 119 0072 05 FFF8 E ADD AX,OFFSET DC:$FT-8 + 120 0075 97 XCHG AX,DI + 121 0076 1E PUSH DS + 122 0077 56 PUSH SI + 123 0078 8B F7 MOV SI,DI + 124 007A 06 PUSH ES + 125 007B 1F POP DS + 126 007C FF 26 0004 R JMP [POINTER] + 127 + 128 + 129 0080 $SAVREG PROC FAR + 130 + 131 ; This routine saves all registers on the stack. It returns with the top + 132 ; of the stack containing a return address to a routine that restores the + 133 ; registers and returns to user code. Flags set by the library are passed + 134 ; back to the user program (so compares work). + 135 + 136 0080 8F 06 0004 R POP [POINTER] + 137 0084 89 26 0000 E MOV [$$SPSV],SP + 138 0088 55 PUSH BP + 139 0089 56 PUSH SI + 140 008A 57 PUSH DI + 141 008B 50 PUSH AX + 142 008C 51 PUSH CX + 143 008D 52 PUSH DX + 144 008E 53 PUSH BX + 145 008F FF 16 0004 R CALL [POINTER] + 146 0093 5B POP BX + 147 0094 5A POP DX + 148 0095 59 POP CX + 149 0096 58 POP AX + 150 0097 5F POP DI + 151 0098 5E POP SI + 152 0099 5D POP BP + 153 009A CB RET + 154 + 155 009B $SAVREG ENDP + 156 009B CODE ENDS + 157 END + + + + + + + +FLOAT - Floating point entry points Macro-86 %1(12) 1:1:30 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 009B BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0006 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +DISAVE . . . . . . . . . . . . . L WORD 0002 DATA +FLTASS . . . . . . . . . . . . . F PROC 0000 CODE Length =0062 +POINTER. . . . . . . . . . . . . L WORD 0004 DATA +SISAVE . . . . . . . . . . . . . L WORD 0000 DATA +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$FASA. . . . . . . . . . . . . . L NEAR 0003 CODE Global +$FASB. . . . . . . . . . . . . . L NEAR 000F CODE Global +$FASC. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FASD. . . . . . . . . . . . . . L NEAR 000C CODE Global +$FT. . . . . . . . . . . . . . . V WORD 0000 DATA External +$GTMP. . . . . . . . . . . . . . L NEAR 0062 CODE Global +$LDFA. . . . . . . . . . . . . . L NEAR 001A CODE Global +$LDFB. . . . . . . . . . . . . . L NEAR 0023 CODE Global +$SAVREG. . . . . . . . . . . . . F PROC 0080 CODE Global Length =001B +$STFA. . . . . . . . . . . . . . L NEAR 002E CODE Global +$STFB. . . . . . . . . . . . . . L NEAR 0047 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/FLOAT.ASM b/3_source_code/BASLIB-86/FLOAT.ASM new file mode 100644 index 0000000..5db5f61 --- /dev/null +++ b/3_source_code/BASLIB-86/FLOAT.ASM @@ -0,0 +1,157 @@ + TITLE FLOAT - Floating point entry points + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $AC:WORD, $DAC:WORD, $FT:WORD, $$SPSV:WORD + +SISAVE DW ? +DISAVE DW ? +POINTER DW ? + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FASA, $FASB, $FASC, $FASD + PUBLIC $STFA, $STFB, $LDFA, $LDFB + PUBLIC $SAVREG, $GTMP + + ASSUME CS:CODE, DS:DC, ES:DC + + +; Floating point assignment + +FLTASS PROC FAR ;Set up long returns + +; $FASA - Assign [SI] to [DI], single precision +; $FASB - Assign [SI] to [DI], double precision +; $FASC - Assign FAC to [DI], single precision +; $FASD - Assign FAC to [DI], double precision +; $STFA - Store FAC in temp, SP +; $STFB - Store FAC in temp, DP +; $LDFA - Load FAC from [SI], SP +; $LDFB - Load FAC from [SI], DP + +$FASC: + MOV SI,OFFSET DC:$AC +$FASA: + MOVSW + MOVSW + SUB DI,4 + SUB SI,4 + RET + +$FASD: + MOV SI,OFFSET DC:$DAC +$FASB: + MOVSW + MOVSW + MOVSW + MOVSW + SUB DI,8 + SUB SI,8 + RET + +$LDFA: + MOV DI,OFFSET DC:$AC + MOVSW + MOVSW + SUB SI,4 + RET + +$LDFB: + MOV DI,OFFSET DC:$DAC + MOVSW + MOVSW + MOVSW + MOVSW + SUB SI,8 + RET + +$STFA: + MOV [SISAVE],SI + MOV [DISAVE],DI + CALL $GTMP + MOV SI,OFFSET DC:$AC + MOVSW + MOVSW + MOV SI,[SISAVE] + MOV DI,[DISAVE] + RET + +$STFB: + MOV [SISAVE],SI + MOV [DISAVE],DI + CALL $GTMP + MOV SI,OFFSET DC:$DAC + MOVSW + MOVSW + MOVSW + MOVSW + MOV SI,[SISAVE] + MOV DI,[DISAVE] + RET + +FLTASS ENDP + +$GTMP: + +; Inputs: +; Long return address one level deep on stack points to temp number. +; Function: +; Get address of temp. +; Outputs: +; SI = DI = Address of floating temp. +; Registers: +; Only SI, DI and F affected. + + POP [POINTER] + POP SI + POP DS + XCHG AX,DI + LODSB ;Get temp number + SHL AL,1 + MOV AH,0 + SHL AX,1 + SHL AX,1 + ADD AX,OFFSET DC:$FT-8 + XCHG AX,DI + PUSH DS + PUSH SI + MOV SI,DI + PUSH ES + POP DS + JMP [POINTER] + + +$SAVREG PROC FAR + +; This routine saves all registers on the stack. It returns with the top +; of the stack containing a return address to a routine that restores the +; registers and returns to user code. Flags set by the library are passed +; back to the user program (so compares work). + + POP [POINTER] + MOV [$$SPSV],SP + PUSH BP + PUSH SI + PUSH DI + PUSH AX + PUSH CX + PUSH DX + PUSH BX + CALL [POINTER] + POP BX + POP DX + POP CX + POP AX + POP DI + POP SI + POP BP + RET + +$SAVREG ENDP +CODE ENDS + END From bbcc90c9cd677879613040bd481cd5208216c3e8 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 1 Jul 2026 16:40:26 -0700 Subject: [PATCH 22/53] Transcription of Bundle 9 - FOUT.ASM Code and Listing --- 2_printed_files/bundle_09/FOUT.ASM | 300 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/FOUT.ASM | 181 +++++++++++++++++ 2 files changed, 481 insertions(+) create mode 100644 2_printed_files/bundle_09/FOUT.ASM create mode 100644 3_source_code/BASLIB-86/FOUT.ASM diff --git a/2_printed_files/bundle_09/FOUT.ASM b/2_printed_files/bundle_09/FOUT.ASM new file mode 100644 index 0000000..af6146e --- /dev/null +++ b/2_printed_files/bundle_09/FOUT.ASM @@ -0,0 +1,300 @@ +FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-1 + + + +1 TITLE FOUT - Free-format numeric output +2 +3 0000 DATA SEGMENT WORD PUBLIC 'DATA' +4 +5 EXTRN VALTYP:BYTE, SIGN:BYTE, $AC:WORD, $DAC:WORD, $$SPSV:WORD +6 +7 0000 DATA ENDS +8 +9 DC GROUP DATA +10 +11 0000 CODE SEGMENT BYTE PUBLIC 'CODE' +12 +13 PUBLIC $FOUT, $FOUTBX, $STI, $STR, $STD +14 +15 EXTRN CONASC:NEAR, ASCRND:NEAR, $$CTS:NEAR +16 +17 ASSUME CS:CODE, DS:DC, ES:DC +18 +19 +20 0000 STRF PROC FAR +21 +22 ;*** $STI, $STR, $STD - STR$ function +23 ; +24 ; Inputs: +25 ; BX = Integer ($STI only) +26 ; BX = Address of number ($STR and $STD) +27 ; Function: +28 ; Create a string representing the number in ASCII +29 ; Outputs: +30 ; BX = Address of string descriptor +31 ; Registers: +32 ; Only BX and F affected. +33 +34 0000 $STI: +35 0000 C6 06 0000 E 02 MOV [VALTYP],2 +36 0005 EB 0C JMP SHORT STR$ +37 +38 0007 $STR: +39 0007 C6 06 0000 E 04 MOV [VALTYP],4 +40 000C EB 05 JMP SHORT STR$ +41 +42 000E $STD: +43 000E C6 06 0000 E 08 MOV [VALTYP],8 +44 0013 STR$: +45 0013 89 26 0000 E MOV [$$SPSV],SP +46 0017 FF 36 0000 E PUSH [$DAC] ;Save DAC +47 001B FF 36 0002 E PUSH [$DAC+2] +48 001F FF 36 0004 E PUSH [$DAC+4] +49 0023 FF 36 0006 E PUSH [$DAC+6] +50 0027 50 PUSH AX +51 0028 51 PUSH CX +52 0029 52 PUSH DX +53 002A 56 PUSH SI +54 002B 57 PUSH DI + + +FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-2 + + + +55 002C 55 PUSH BP +56 002D E8 004D R CALL $FOUTBX +57 0030 93 XCHG AX,BX ;Get length in BX +58 0031 8B D6 MOV DX,SI ;Get address in DX +59 0033 E8 0000 E CALL $$CTS ;Create temp string +60 0036 5D POP BP +61 0037 5F POP DI +62 0038 5E POP SI +63 0039 5A POP DX +64 003A 59 POP CX +65 003B 58 POP AX +66 003C 8F 06 0006 E POP [$DAC+6] +67 0040 8F 06 0004 E POP [$DAC+4] +68 0044 8F 06 0002 E POP [$DAC+2] +69 0048 8F 06 0000 E POP [$DAC] +70 004C CB RET +71 +72 004D STRF ENDP +73 +74 +75 ;*** $FOUT & $FOUTBX - Free-format numeric output +76 ; +77 ; Inputs: +78 ; Number in FAC to be formatted for output ($FOUT only) +79 ; BX = Number to be formatted ($FOUTBX only) +80 ; [VALTYP] = 2 for integer, 4 for SP, 8 for DP +81 ; Function: +82 ; Format number for printing, using BASIC's formatting rules. +83 ; Outputs: +84 ; SI = Address of ASCII string, terminated by 00 +85 ; AX = Length of string (not including terminating 00) +86 ; Registers: +87 ; All destroyed. +88 +89 004D $FOUTBX: +90 004D A0 0000 E MOV AL,[VALTYP] +91 0050 3C 02 CMP AL,2 +92 0052 74 0F JZ STOINT +93 0054 98 CBW ;Number of bytes to move +94 0055 8B F3 MOV SI,BX +95 0057 BF 0004 E MOV DI,OFFSET DC:$AC+4 +96 005A 2B F8 SUB DI,AX ;AC or DAC +97 005C 91 XCHG AX,CX +98 005D D1 E9 SHR CX,1 ;Count of words +99 005F F3/ A5 REP MOVSW +100 0061 EB 04 JMP SHORT $FOUT +101 0063 STOINT: +102 0063 89 1E 0000 E MOV [$AC],BX +103 0067 $FOUT: +104 0067 E8 0000 E CALL CONASC ;Most of the work's done here +105 +106 ;Number has been converted to ASCII and is sitting at buffer pointed to by DI. +107 ; SI = address of result buffer +108 ; CX = number of significant figures + + +FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-3 + + + +109 ; DL has the base 10 exponent of the right end of the digit string. +110 +111 006A BB F907 MOV BX,-700H+7 ;If SP, use 7 digits, but limit 7 to right +112 006D 80 3E 0000 E 04 CMP [VALTYP],4 ;What type? +113 0072 76 03 JBE RNDDIG ;If integer or SP, use SP parameters +114 0074 BB F010 MOV BX,-1000H+16 ;For DP, use 16 digits, and limit 16 to right +115 0077 RNDDIG: +116 0077 8A C3 MOV AL,BL +117 0079 E8 0000 E CALL ASCRND ;Round to AL digits +118 007C 3A D7 CMP DL,BH ;Too many digits to right of decimal point? +119 007E 7C 33 JL SCINOT ;If so, use scientific notation +120 0080 8A C2 MOV AL,DL +121 0082 02 C1 ADD AL,CL ;AL=number of digits to left of dec.pt. +122 0084 3A C3 CMP AL,BL ;Too many? +123 0086 7F 2B JG SCINOT ;If so, use scientific notation +124 0088 98 CBW +125 0089 91 XCHG AX,CX ;CX has digits needed to left of dec. pt. +126 008A 93 XCHG AX,BX ;BX has digits available from buffer +127 008B 0B C9 OR CX,CX ;Any to left? +128 008D 7E 20 JLE LESS1 ;If not, start with decimal point +129 008F LEFTDP: +130 008F A4 MOVSB ;Move digits to final buffer +131 0090 4B DEC BX ;Limit to available digits +132 0091 E0 FC LOOPNZ LEFTDP +133 0093 B0 30 MOV AL,"0" +134 0095 F3/ AA REP STOSB ;Fill in with place-holding zeros if needed +135 0097 74 0B JZ PUTEND ;If out of digits, were done(flags from DEC BX) +136 0099 PUTDP: +137 0099 B0 2E MOV AL,"." +138 009B AA STOSB ;Put in decimal point +139 009C B0 30 MOV AL,"0" ;Used only if we came from LESS1 +140 009E F3/ AA REP STOSB ;Add leading zeros if a small number +141 00A0 8B CB MOV CX,BX ;Number of digits left +142 00A2 F3/ A4 REP MOVSB +143 00A4 PUTEND: +144 00A4 BE 0000 E MOV SI,OFFSET DC:SIGN ;Leave pointer to buffer +145 00A7 8B C7 MOV AX,DI +146 00A9 2B C6 SUB AX,SI ;Length of string +147 00AB C6 05 00 MOV BYTE PTR[DI],0 ;Put in terminating zero +148 00AE C3 RET +149 +150 00AF LESS1: +151 ;Come here if number is less than one and therefore has no digits to +152 ;left of the decimal point. +153 00AF F7 D9 NEG CX ;Number of place-holding zeros needed +154 00B1 EB E6 JMP PUTDP ; after the decimal point +155 +156 00B3 SCINOT: +157 00B3 A4 MOVSB ;Move first digit to final buffer +158 00B4 49 DEC CX ;Account for digit already moved +159 00B5 74 07 JZ EXP ;Skip decimal point if only one digit +160 00B7 B0 2E MOV AL,"." +161 00B9 AA STOSB +162 00BA 02 D1 ADD DL,CL ;Correct exponent for decimal point position + + +FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-4 + + + +163 00BC F3/ A4 REP MOVSB ;All other digits go after decimal point +164 00BE EXP: +165 00BE B8 2B45 MOV AX,"+E" ;Prepare "E+" if positive exponent +166 00C1 0A D2 OR DL,DL ;Check exponent sign +167 00C3 79 04 JNS POSEXP +168 00C5 F6 DA NEG DL ;Force exponent positive +169 00C7 B4 2D MOV AH,"-" +170 00C9 POSEXP: +171 00C9 AB STOSW +172 00CA 92 XCHG AX,DX ;Get exponent in AL +173 00CB D4 0A AAM ;Convert binary to unpacked BCD +174 00CD 86 C4 XCHG AL,AH +175 00CF 0D 3030 OR AX,"00" ;Add ASCII bias +176 00D2 AB STOSW +177 00D3 EB CF JMP PUTEND +178 +179 00D5 CODE ENDS +180 +181 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00D5 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ASCRND . . . . . . . . . . . . . L NEAR 0000 CODE External +CONASC . . . . . . . . . . . . . L NEAR 0000 CODE External +EXP. . . . . . . . . . . . . . . L NEAR 00BE CODE +LEFTDP . . . . . . . . . . . . . L NEAR 008F CODE +LESS1. . . . . . . . . . . . . . L NEAR 00AF CODE +POSEXP . . . . . . . . . . . . . L NEAR 00C9 CODE +PUTDP. . . . . . . . . . . . . . L NEAR 0099 CODE +PUTEND . . . . . . . . . . . . . L NEAR 00A4 CODE +RNDDIG . . . . . . . . . . . . . L NEAR 0077 CODE +SCINOT . . . . . . . . . . . . . L NEAR 00B3 CODE +SIGN . . . . . . . . . . . . . . V BYTE 0000 DATA External +STOINT . . . . . . . . . . . . . L NEAR 0063 CODE +STR$ . . . . . . . . . . . . . . L NEAR 0013 CODE +STRF . . . . . . . . . . . . . . F PROC 0000 CODE Length =004D +VALTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +$$CTS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$FOUT. . . . . . . . . . . . . . L NEAR 0067 CODE Global +$FOUTBX. . . . . . . . . . . . . L NEAR 004D CODE Global +$STD . . . . . . . . . . . . . . L NEAR 000E CODE Global +$STI . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$STR . . . . . . . . . . . . . . L NEAR 0007 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/FOUT.ASM b/3_source_code/BASLIB-86/FOUT.ASM new file mode 100644 index 0000000..a1b6d28 --- /dev/null +++ b/3_source_code/BASLIB-86/FOUT.ASM @@ -0,0 +1,181 @@ + TITLE FOUT - Free-format numeric output + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN VALTYP:BYTE, SIGN:BYTE, $AC:WORD, $DAC:WORD, $$SPSV:WORD + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FOUT, $FOUTBX, $STI, $STR, $STD + + EXTRN CONASC:NEAR, ASCRND:NEAR, $$CTS:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +STRF PROC FAR + +;*** $STI, $STR, $STD - STR$ function +; +; Inputs: +; BX = Integer ($STI only) +; BX = Address of number ($STR and $STD) +; Function: +; Create a string representing the number in ASCII +; Outputs: +; BX = Address of string descriptor +; Registers: +; Only BX and F affected. + +$STI: + MOV [VALTYP],2 + JMP SHORT STR$ + +$STR: + MOV [VALTYP],4 + JMP SHORT STR$ + +$STD: + MOV [VALTYP],8 +STR$: + MOV [$$SPSV],SP + PUSH [$DAC] ;Save DAC + PUSH [$DAC+2] + PUSH [$DAC+4] + PUSH [$DAC+6] + PUSH AX + PUSH CX + PUSH DX + PUSH SI + PUSH DI + PUSH BP + CALL $FOUTBX + XCHG AX,BX ;Get length in BX + MOV DX,SI ;Get address in DX + CALL $$CTS ;Create temp string + POP BP + POP DI + POP SI + POP DX + POP CX + POP AX + POP [$DAC+6] + POP [$DAC+4] + POP [$DAC+2] + POP [$DAC] + RET + +STRF ENDP + + +;*** $FOUT & $FOUTBX - Free-format numeric output +; +; Inputs: +; Number in FAC to be formatted for output ($FOUT only) +; BX = Number to be formatted ($FOUTBX only) +; [VALTYP] = 2 for integer, 4 for SP, 8 for DP +; Function: +; Format number for printing, using BASIC's formatting rules. +; Outputs: +; SI = Address of ASCII string, terminated by 00 +; AX = Length of string (not including terminating 00) +; Registers: +; All destroyed. + +$FOUTBX: + MOV AL,[VALTYP] + CMP AL,2 + JZ STOINT + CBW ;Number of bytes to move + MOV SI,BX + MOV DI,OFFSET DC:$AC+4 + SUB DI,AX ;AC or DAC + XCHG AX,CX + SHR CX,1 ;Count of words + REP MOVSW + JMP SHORT $FOUT +STOINT: + MOV [$AC],BX +$FOUT: + CALL CONASC ;Most of the work's done here + +;Number has been converted to ASCII and is sitting at buffer pointed to by DI. +; SI = address of result buffer +; CX = number of significant figures +; DL has the base 10 exponent of the right end of the digit string. + + MOV BX,-700H+7 ;If SP, use 7 digits, but limit 7 to right + CMP [VALTYP],4 ;What type? + JBE RNDDIG ;If integer or SP, use SP parameters + MOV BX,-1000H+16 ;For DP, use 16 digits, and limit 16 to right +RNDDIG: + MOV AL,BL + CALL ASCRND ;Round to AL digits + CMP DL,BH ;Too many digits to right of decimal point? + JL SCINOT ;If so, use scientific notation + MOV AL,DL + ADD AL,CL ;AL=number of digits to left of dec.pt. + CMP AL,BL ;Too many? + JG SCINOT ;If so, use scientific notation + CBW + XCHG AX,CX ;CX has digits needed to left of dec. pt. + XCHG AX,BX ;BX has digits available from buffer + OR CX,CX ;Any to left? + JLE LESS1 ;If not, start with decimal point +LEFTDP: + MOVSB ;Move digits to final buffer + DEC BX ;Limit to available digits + LOOPNZ LEFTDP + MOV AL,"0" + REP STOSB ;Fill in with place-holding zeros if needed + JZ PUTEND ;If out of digits, were done(flags from DEC BX) +PUTDP: + MOV AL,"." + STOSB ;Put in decimal point + MOV AL,"0" ;Used only if we came from LESS1 + REP STOSB ;Add leading zeros if a small number + MOV CX,BX ;Number of digits left + REP MOVSB +PUTEND: + MOV SI,OFFSET DC:SIGN ;Leave pointer to buffer + MOV AX,DI + SUB AX,SI ;Length of string + MOV BYTE PTR[DI],0 ;Put in terminating zero + RET + +LESS1: +;Come here if number is less than one and therefore has no digits to +;left of the decimal point. + NEG CX ;Number of place-holding zeros needed + JMP PUTDP ; after the decimal point + +SCINOT: + MOVSB ;Move first digit to final buffer + DEC CX ;Account for digit already moved + JZ EXP ;Skip decimal point if only one digit + MOV AL,"." + STOSB + ADD DL,CL ;Correct exponent for decimal point position + REP MOVSB ;All other digits go after decimal point +EXP: + MOV AX,"+E" ;Prepare "E+" if positive exponent + OR DL,DL ;Check exponent sign + JNS POSEXP + NEG DL ;Force exponent positive + MOV AH,"-" +POSEXP: + STOSW + XCHG AX,DX ;Get exponent in AL + AAM ;Convert binary to unpacked BCD + XCHG AL,AH + OR AX,"00" ;Add ASCII bias + STOSW + JMP PUTEND + +CODE ENDS + + END From c02934e351ce302a3f17b1e703f719afcd58d68c Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 2 Jul 2026 09:41:46 -0700 Subject: [PATCH 23/53] Corrected data entry error in FOUT.ASM --- 2_printed_files/bundle_09/FOUT.ASM | 362 ++++++++++++++--------------- 1 file changed, 181 insertions(+), 181 deletions(-) diff --git a/2_printed_files/bundle_09/FOUT.ASM b/2_printed_files/bundle_09/FOUT.ASM index af6146e..3cfbcf6 100644 --- a/2_printed_files/bundle_09/FOUT.ASM +++ b/2_printed_files/bundle_09/FOUT.ASM @@ -2,205 +2,205 @@ FOUT - Free-format numeric output Macro-86 %1(12) 1:1:3 -1 TITLE FOUT - Free-format numeric output -2 -3 0000 DATA SEGMENT WORD PUBLIC 'DATA' -4 -5 EXTRN VALTYP:BYTE, SIGN:BYTE, $AC:WORD, $DAC:WORD, $$SPSV:WORD -6 -7 0000 DATA ENDS -8 -9 DC GROUP DATA -10 -11 0000 CODE SEGMENT BYTE PUBLIC 'CODE' -12 -13 PUBLIC $FOUT, $FOUTBX, $STI, $STR, $STD -14 -15 EXTRN CONASC:NEAR, ASCRND:NEAR, $$CTS:NEAR -16 -17 ASSUME CS:CODE, DS:DC, ES:DC -18 -19 -20 0000 STRF PROC FAR -21 -22 ;*** $STI, $STR, $STD - STR$ function -23 ; -24 ; Inputs: -25 ; BX = Integer ($STI only) -26 ; BX = Address of number ($STR and $STD) -27 ; Function: -28 ; Create a string representing the number in ASCII -29 ; Outputs: -30 ; BX = Address of string descriptor -31 ; Registers: -32 ; Only BX and F affected. -33 -34 0000 $STI: -35 0000 C6 06 0000 E 02 MOV [VALTYP],2 -36 0005 EB 0C JMP SHORT STR$ -37 -38 0007 $STR: -39 0007 C6 06 0000 E 04 MOV [VALTYP],4 -40 000C EB 05 JMP SHORT STR$ -41 -42 000E $STD: -43 000E C6 06 0000 E 08 MOV [VALTYP],8 -44 0013 STR$: -45 0013 89 26 0000 E MOV [$$SPSV],SP -46 0017 FF 36 0000 E PUSH [$DAC] ;Save DAC -47 001B FF 36 0002 E PUSH [$DAC+2] -48 001F FF 36 0004 E PUSH [$DAC+4] -49 0023 FF 36 0006 E PUSH [$DAC+6] -50 0027 50 PUSH AX -51 0028 51 PUSH CX -52 0029 52 PUSH DX -53 002A 56 PUSH SI -54 002B 57 PUSH DI + 1 TITLE FOUT - Free-format numeric output + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN VALTYP:BYTE, SIGN:BYTE, $AC:WORD, $DAC:WORD, $$SPSV:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 DC GROUP DATA + 10 + 11 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 12 + 13 PUBLIC $FOUT, $FOUTBX, $STI, $STR, $STD + 14 + 15 EXTRN CONASC:NEAR, ASCRND:NEAR, $$CTS:NEAR + 16 + 17 ASSUME CS:CODE, DS:DC, ES:DC + 18 + 19 + 20 0000 STRF PROC FAR + 21 + 22 ;*** $STI, $STR, $STD - STR$ function + 23 ; + 24 ; Inputs: + 25 ; BX = Integer ($STI only) + 26 ; BX = Address of number ($STR and $STD) + 27 ; Function: + 28 ; Create a string representing the number in ASCII + 29 ; Outputs: + 30 ; BX = Address of string descriptor + 31 ; Registers: + 32 ; Only BX and F affected. + 33 + 34 0000 $STI: + 35 0000 C6 06 0000 E 02 MOV [VALTYP],2 + 36 0005 EB 0C JMP SHORT STR$ + 37 + 38 0007 $STR: + 39 0007 C6 06 0000 E 04 MOV [VALTYP],4 + 40 000C EB 05 JMP SHORT STR$ + 41 + 42 000E $STD: + 43 000E C6 06 0000 E 08 MOV [VALTYP],8 + 44 0013 STR$: + 45 0013 89 26 0000 E MOV [$$SPSV],SP + 46 0017 FF 36 0000 E PUSH [$DAC] ;Save DAC + 47 001B FF 36 0002 E PUSH [$DAC+2] + 48 001F FF 36 0004 E PUSH [$DAC+4] + 49 0023 FF 36 0006 E PUSH [$DAC+6] + 50 0027 50 PUSH AX + 51 0028 51 PUSH CX + 52 0029 52 PUSH DX + 53 002A 56 PUSH SI + 54 002B 57 PUSH DI FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-2 -55 002C 55 PUSH BP -56 002D E8 004D R CALL $FOUTBX -57 0030 93 XCHG AX,BX ;Get length in BX -58 0031 8B D6 MOV DX,SI ;Get address in DX -59 0033 E8 0000 E CALL $$CTS ;Create temp string -60 0036 5D POP BP -61 0037 5F POP DI -62 0038 5E POP SI -63 0039 5A POP DX -64 003A 59 POP CX -65 003B 58 POP AX -66 003C 8F 06 0006 E POP [$DAC+6] -67 0040 8F 06 0004 E POP [$DAC+4] -68 0044 8F 06 0002 E POP [$DAC+2] -69 0048 8F 06 0000 E POP [$DAC] -70 004C CB RET -71 -72 004D STRF ENDP -73 -74 -75 ;*** $FOUT & $FOUTBX - Free-format numeric output -76 ; -77 ; Inputs: -78 ; Number in FAC to be formatted for output ($FOUT only) -79 ; BX = Number to be formatted ($FOUTBX only) -80 ; [VALTYP] = 2 for integer, 4 for SP, 8 for DP -81 ; Function: -82 ; Format number for printing, using BASIC's formatting rules. -83 ; Outputs: -84 ; SI = Address of ASCII string, terminated by 00 -85 ; AX = Length of string (not including terminating 00) -86 ; Registers: -87 ; All destroyed. -88 -89 004D $FOUTBX: -90 004D A0 0000 E MOV AL,[VALTYP] -91 0050 3C 02 CMP AL,2 -92 0052 74 0F JZ STOINT -93 0054 98 CBW ;Number of bytes to move -94 0055 8B F3 MOV SI,BX -95 0057 BF 0004 E MOV DI,OFFSET DC:$AC+4 -96 005A 2B F8 SUB DI,AX ;AC or DAC -97 005C 91 XCHG AX,CX -98 005D D1 E9 SHR CX,1 ;Count of words -99 005F F3/ A5 REP MOVSW -100 0061 EB 04 JMP SHORT $FOUT -101 0063 STOINT: -102 0063 89 1E 0000 E MOV [$AC],BX -103 0067 $FOUT: -104 0067 E8 0000 E CALL CONASC ;Most of the work's done here -105 -106 ;Number has been converted to ASCII and is sitting at buffer pointed to by DI. -107 ; SI = address of result buffer -108 ; CX = number of significant figures + 55 002C 55 PUSH BP + 56 002D E8 004D R CALL $FOUTBX + 57 0030 93 XCHG AX,BX ;Get length in BX + 58 0031 8B D6 MOV DX,SI ;Get address in DX + 59 0033 E8 0000 E CALL $$CTS ;Create temp string + 60 0036 5D POP BP + 61 0037 5F POP DI + 62 0038 5E POP SI + 63 0039 5A POP DX + 64 003A 59 POP CX + 65 003B 58 POP AX + 66 003C 8F 06 0006 E POP [$DAC+6] + 67 0040 8F 06 0004 E POP [$DAC+4] + 68 0044 8F 06 0002 E POP [$DAC+2] + 69 0048 8F 06 0000 E POP [$DAC] + 70 004C CB RET + 71 + 72 004D STRF ENDP + 73 + 74 + 75 ;*** $FOUT & $FOUTBX - Free-format numeric output + 76 ; + 77 ; Inputs: + 78 ; Number in FAC to be formatted for output ($FOUT only) + 79 ; BX = Number to be formatted ($FOUTBX only) + 80 ; [VALTYP] = 2 for integer, 4 for SP, 8 for DP + 81 ; Function: + 82 ; Format number for printing, using BASIC's formatting rules. + 83 ; Outputs: + 84 ; SI = Address of ASCII string, terminated by 00 + 85 ; AX = Length of string (not including terminating 00) + 86 ; Registers: + 87 ; All destroyed. + 88 + 89 004D $FOUTBX: + 90 004D A0 0000 E MOV AL,[VALTYP] + 91 0050 3C 02 CMP AL,2 + 92 0052 74 0F JZ STOINT + 93 0054 98 CBW ;Number of bytes to move + 94 0055 8B F3 MOV SI,BX + 95 0057 BF 0004 E MOV DI,OFFSET DC:$AC+4 + 96 005A 2B F8 SUB DI,AX ;AC or DAC + 97 005C 91 XCHG AX,CX + 98 005D D1 E9 SHR CX,1 ;Count of words + 99 005F F3/ A5 REP MOVSW + 100 0061 EB 04 JMP SHORT $FOUT + 101 0063 STOINT: + 102 0063 89 1E 0000 E MOV [$AC],BX + 103 0067 $FOUT: + 104 0067 E8 0000 E CALL CONASC ;Most of the work's done here + 105 + 106 ;Number has been converted to ASCII and is sitting at buffer pointed to by DI. + 107 ; SI = address of result buffer + 108 ; CX = number of significant figures FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-3 -109 ; DL has the base 10 exponent of the right end of the digit string. -110 -111 006A BB F907 MOV BX,-700H+7 ;If SP, use 7 digits, but limit 7 to right -112 006D 80 3E 0000 E 04 CMP [VALTYP],4 ;What type? -113 0072 76 03 JBE RNDDIG ;If integer or SP, use SP parameters -114 0074 BB F010 MOV BX,-1000H+16 ;For DP, use 16 digits, and limit 16 to right -115 0077 RNDDIG: -116 0077 8A C3 MOV AL,BL -117 0079 E8 0000 E CALL ASCRND ;Round to AL digits -118 007C 3A D7 CMP DL,BH ;Too many digits to right of decimal point? -119 007E 7C 33 JL SCINOT ;If so, use scientific notation -120 0080 8A C2 MOV AL,DL -121 0082 02 C1 ADD AL,CL ;AL=number of digits to left of dec.pt. -122 0084 3A C3 CMP AL,BL ;Too many? -123 0086 7F 2B JG SCINOT ;If so, use scientific notation -124 0088 98 CBW -125 0089 91 XCHG AX,CX ;CX has digits needed to left of dec. pt. -126 008A 93 XCHG AX,BX ;BX has digits available from buffer -127 008B 0B C9 OR CX,CX ;Any to left? -128 008D 7E 20 JLE LESS1 ;If not, start with decimal point -129 008F LEFTDP: -130 008F A4 MOVSB ;Move digits to final buffer -131 0090 4B DEC BX ;Limit to available digits -132 0091 E0 FC LOOPNZ LEFTDP -133 0093 B0 30 MOV AL,"0" -134 0095 F3/ AA REP STOSB ;Fill in with place-holding zeros if needed -135 0097 74 0B JZ PUTEND ;If out of digits, were done(flags from DEC BX) -136 0099 PUTDP: -137 0099 B0 2E MOV AL,"." -138 009B AA STOSB ;Put in decimal point -139 009C B0 30 MOV AL,"0" ;Used only if we came from LESS1 -140 009E F3/ AA REP STOSB ;Add leading zeros if a small number -141 00A0 8B CB MOV CX,BX ;Number of digits left -142 00A2 F3/ A4 REP MOVSB -143 00A4 PUTEND: -144 00A4 BE 0000 E MOV SI,OFFSET DC:SIGN ;Leave pointer to buffer -145 00A7 8B C7 MOV AX,DI -146 00A9 2B C6 SUB AX,SI ;Length of string -147 00AB C6 05 00 MOV BYTE PTR[DI],0 ;Put in terminating zero -148 00AE C3 RET -149 -150 00AF LESS1: -151 ;Come here if number is less than one and therefore has no digits to -152 ;left of the decimal point. -153 00AF F7 D9 NEG CX ;Number of place-holding zeros needed -154 00B1 EB E6 JMP PUTDP ; after the decimal point -155 -156 00B3 SCINOT: -157 00B3 A4 MOVSB ;Move first digit to final buffer -158 00B4 49 DEC CX ;Account for digit already moved -159 00B5 74 07 JZ EXP ;Skip decimal point if only one digit -160 00B7 B0 2E MOV AL,"." -161 00B9 AA STOSB -162 00BA 02 D1 ADD DL,CL ;Correct exponent for decimal point position + 109 ; DL has the base 10 exponent of the right end of the digit string. + 110 + 111 006A BB F907 MOV BX,-700H+7 ;If SP, use 7 digits, but limit 7 to right + 112 006D 80 3E 0000 E 04 CMP [VALTYP],4 ;What type? + 113 0072 76 03 JBE RNDDIG ;If integer or SP, use SP parameters + 114 0074 BB F010 MOV BX,-1000H+16 ;For DP, use 16 digits, and limit 16 to right + 115 0077 RNDDIG: + 116 0077 8A C3 MOV AL,BL + 117 0079 E8 0000 E CALL ASCRND ;Round to AL digits + 118 007C 3A D7 CMP DL,BH ;Too many digits to right of decimal point? + 119 007E 7C 33 JL SCINOT ;If so, use scientific notation + 120 0080 8A C2 MOV AL,DL + 121 0082 02 C1 ADD AL,CL ;AL=number of digits to left of dec.pt. + 122 0084 3A C3 CMP AL,BL ;Too many? + 123 0086 7F 2B JG SCINOT ;If so, use scientific notation + 124 0088 98 CBW + 125 0089 91 XCHG AX,CX ;CX has digits needed to left of dec. pt. + 126 008A 93 XCHG AX,BX ;BX has digits available from buffer + 127 008B 0B C9 OR CX,CX ;Any to left? + 128 008D 7E 20 JLE LESS1 ;If not, start with decimal point + 129 008F LEFTDP: + 130 008F A4 MOVSB ;Move digits to final buffer + 131 0090 4B DEC BX ;Limit to available digits + 132 0091 E0 FC LOOPNZ LEFTDP + 133 0093 B0 30 MOV AL,"0" + 134 0095 F3/ AA REP STOSB ;Fill in with place-holding zeros if needed + 135 0097 74 0B JZ PUTEND ;If out of digits, were done(flags from DEC BX) + 136 0099 PUTDP: + 137 0099 B0 2E MOV AL,"." + 138 009B AA STOSB ;Put in decimal point + 139 009C B0 30 MOV AL,"0" ;Used only if we came from LESS1 + 140 009E F3/ AA REP STOSB ;Add leading zeros if a small number + 141 00A0 8B CB MOV CX,BX ;Number of digits left + 142 00A2 F3/ A4 REP MOVSB + 143 00A4 PUTEND: + 144 00A4 BE 0000 E MOV SI,OFFSET DC:SIGN ;Leave pointer to buffer + 145 00A7 8B C7 MOV AX,DI + 146 00A9 2B C6 SUB AX,SI ;Length of string + 147 00AB C6 05 00 MOV BYTE PTR[DI],0 ;Put in terminating zero + 148 00AE C3 RET + 149 + 150 00AF LESS1: + 151 ;Come here if number is less than one and therefore has no digits to + 152 ;left of the decimal point. + 153 00AF F7 D9 NEG CX ;Number of place-holding zeros needed + 154 00B1 EB E6 JMP PUTDP ; after the decimal point + 155 + 156 00B3 SCINOT: + 157 00B3 A4 MOVSB ;Move first digit to final buffer + 158 00B4 49 DEC CX ;Account for digit already moved + 159 00B5 74 07 JZ EXP ;Skip decimal point if only one digit + 160 00B7 B0 2E MOV AL,"." + 161 00B9 AA STOSB + 162 00BA 02 D1 ADD DL,CL ;Correct exponent for decimal point position FOUT - Free-format numeric output Macro-86 %1(12) 1:1:36 13-Nov-81 Page 1-4 -163 00BC F3/ A4 REP MOVSB ;All other digits go after decimal point -164 00BE EXP: -165 00BE B8 2B45 MOV AX,"+E" ;Prepare "E+" if positive exponent -166 00C1 0A D2 OR DL,DL ;Check exponent sign -167 00C3 79 04 JNS POSEXP -168 00C5 F6 DA NEG DL ;Force exponent positive -169 00C7 B4 2D MOV AH,"-" -170 00C9 POSEXP: -171 00C9 AB STOSW -172 00CA 92 XCHG AX,DX ;Get exponent in AL -173 00CB D4 0A AAM ;Convert binary to unpacked BCD -174 00CD 86 C4 XCHG AL,AH -175 00CF 0D 3030 OR AX,"00" ;Add ASCII bias -176 00D2 AB STOSW -177 00D3 EB CF JMP PUTEND -178 -179 00D5 CODE ENDS -180 -181 END + 163 00BC F3/ A4 REP MOVSB ;All other digits go after decimal point + 164 00BE EXP: + 165 00BE B8 2B45 MOV AX,"+E" ;Prepare "E+" if positive exponent + 166 00C1 0A D2 OR DL,DL ;Check exponent sign + 167 00C3 79 04 JNS POSEXP + 168 00C5 F6 DA NEG DL ;Force exponent positive + 169 00C7 B4 2D MOV AH,"-" + 170 00C9 POSEXP: + 171 00C9 AB STOSW + 172 00CA 92 XCHG AX,DX ;Get exponent in AL + 173 00CB D4 0A AAM ;Convert binary to unpacked BCD + 174 00CD 86 C4 XCHG AL,AH + 175 00CF 0D 3030 OR AX,"00" ;Add ASCII bias + 176 00D2 AB STOSW + 177 00D3 EB CF JMP PUTEND + 178 + 179 00D5 CODE ENDS + 180 + 181 END From f5d012a836f8de9c9511559ad4707be0e4cf20bf Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 3 Jul 2026 18:20:35 -0700 Subject: [PATCH 24/53] Transcription of Bundle 9 - GOSTOP.ASM Code and Listing Created file SYSTEM.INC from listing, required for build. (See line 4 for include statement, lines 5-33 for content) Created file LIBMAC.LIB from listing, required for build. (See line 239 for include statement, lines 240-262 for content) --- 2_printed_files/bundle_09/GOSTOP.ASM | 1201 ++++++++++++++++++++++++++ 3_source_code/BASLIB-86/GOSTOP.ASM | 631 ++++++++++++++ 3_source_code/BASLIB-86/LIBMAC.LIB | 23 + 3_source_code/BASLIB-86/SYSTEM.INC | 29 + 4 files changed, 1884 insertions(+) create mode 100644 2_printed_files/bundle_09/GOSTOP.ASM create mode 100644 3_source_code/BASLIB-86/GOSTOP.ASM create mode 100644 3_source_code/BASLIB-86/LIBMAC.LIB create mode 100644 3_source_code/BASLIB-86/SYSTEM.INC diff --git a/2_printed_files/bundle_09/GOSTOP.ASM b/2_printed_files/bundle_09/GOSTOP.ASM new file mode 100644 index 0000000..268cc48 --- /dev/null +++ b/2_printed_files/bundle_09/GOSTOP.ASM @@ -0,0 +1,1201 @@ +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 1-1 + + + + 1 TITLE GOSTOP - Initialization, STOP, END, and error processing + 2 + 3 .sall + 4 C INCLUDE SYSTEM.INC + 5 C ; Operating System Selection + 6 C + 7 = 0000 C _IBM_= 0 + 8 C + 9 = 0001 C _MSDOS_= 1 + 10 = 0000 C _CPM_= 0 + 11 C + 12 C ; Overrides + 13 C + 14 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ + 15 C + 16 C if1 + 17 C if _CPM_ + 18 C %OUT ! CP/M-86 Version + 19 C endif + 20 C if _MSDOS_ + 21 C %OUT ! MSDOS Version + 22 C endif + 23 C if _IBM_ + 24 C %OUT ! IBM Personal Computer + 25 C endif + 26 C + 27 C if _MSDOS_+_CPM_ ne 1 + 28 C %OUT ##################### Error - Bad Operating System Selection + 29 C + 30 C error + 31 C endif + 32 C endif + 33 C + 34 C INCLUDE ADDR.INC + 35 = 0000 C O_STA EQU 0 ;Statement address/number table + 36 = 0002 C STARTDATA EQU 2 ;Start of data statements + 37 = 0006 C O_RAM EQU 6 ;Start of user RAM + 38 = 000C C O_RAL EQU 0CH ;End of user RAM + 1 + 39 + 40 + 41 ERRMSG MACRO Errnum,Errtxt + 42 .xcref + 43 __Pchr = 0 + 44 DB Errnum + 45 IRPC chr, + 46 IF __Pchr + 47 DB &__Pchr + 48 ENDIF + 49 __Pchr = "&chr" + 50 ENDM + 51 DB __Pchr+128 + 52 .cref + 53 ENDM + 54 + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 1-2 + + + + 55 TYPMSG MACRO Txt + 56 __Pchr = 0 + 57 CALL $TYPTX ;;Print Following string to CON + 58 IRPC chr, + 59 IF __Pchr + 60 DB &__Pchr + 61 ENDIF + 62 __Pchr = "&chr" + 63 ENDM + 64 DB __Pchr+128 + 65 ENDM + 66 + 67 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 68 + 69 PUBLIC $SEG,$USR + 70 + 71 PUBLIC $DAC,$AC,$FAC + 72 PUBLIC $$ERRV,$$SPSV,$$STKP,$MAINBASE + 73 + 74 0000 ???? $SEG DW ? + 75 0002 0A [ $USR DW 10 DUP (?) + 76 ???? + 77 ] + 78 + 79 + 80 0016 04 [ $DAC DB 4 DUP(?) + 81 ?? + 82 ] + 83 + 84 001A 03 [ $AC DB 3 DUP(?) + 85 ?? + 86 ] + 87 + 88 001D ?? $FAC DB ? + 89 + 90 001E ???? $$ERRV DW ? ;Special error handler address + 91 0020 ???? $$SPSV DW ? ;Save stack here + 92 0022 ???? $$STKP DW ? + 93 + 94 0024 CBASE LABEL DWORD + 95 0024 ???? $MAINBASE DW ? ;Starting offset of main + 96 0026 ???? MAINCS DW ? ;CS of main program + 97 + 98 0028 DATA ENDS + 99 + 100 0028 DATA SEGMENT WORD PUBLIC 'DATA' + 101 + 102 ;This data area is zeroed on initialization and each CLEAR + 103 + 104 PUBLIC $FREPT,$FILPT,$PTRFIL,$$AOER,$$OEIP,$$RSTO + 105 PUBLIC $ERRNUM,$ERRLIN,$ERRADR,$$GCNT + 106 PUBLIC $TRACE_SW + 107 + 108 0028 STARTZERO LABEL BYTE + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 1-3 + + + + 109 + 110 0028 ???? $ERRADR DW ? ;Error address + 111 002A ???? $ERRNUM DW ? ;Error number + 112 002C ???? $ERRLIN DW ? ;Error line + 113 + 114 002E ???? $FREPT DW ? ;File block free list + 115 0030 ???? $FILPT DW ? ;Active file list + 116 0032 ???? $PTRFIL DW ? ;Current file pointer + 117 0034 ???? $$AOER DW ? ;ON ERROR address + 118 0036 ???? $$GCNT DW ? ;GOSUB count + 119 0038 ?? $$RSTO DB ? ;Has RESTORE occurred yet? + 120 0039 ?? $$OEIP DB ? ;ON ERROR in progress + 121 003A ?? $TRACE_SW DB ? ;Trace switch + 122 + 123 003B STOPZERO LABEL BYTE + 124 + 125 003B DATA ENDS + 126 + 127 + 128 0000 BC_CN SEGMENT WORD PUBLIC 'DATA' + 129 0000 END_CN LABEL BYTE + 130 0000 BC_CN ENDS + 131 + 132 0000 BC_DS SEGMENT BYTE PUBLIC 'DATA' + 133 0000 END_DS LABEL BYTE + 134 0000 BC_DS ENDS + 135 + 136 DC GROUP BC_CN,BC_DS,DATA + 137 + 138 + 139 0000 BC_ICN SEGMENT WORD PUBLIC 'INIT' + 140 0000 END_ICN LABEL BYTE + 141 0000 BC_ICN ENDS + 142 + 143 0000 BC_IDS SEGMENT BYTE PUBLIC 'INIT' + 144 0000 END_IDS LABEL BYTE + 145 0000 BC_IDS ENDS + 146 + + + + + + + + + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 2-1 + + + + 147 + 148 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 149 + 150 0000 ERRTAB LABEL BYTE + 151 ERRMSG 2, + 152 ERRMSG 3, + 153 ERRMSG 4, + 154 ERRMSG 5, + 155 ERRMSG 6, + 156 ERRMSG 7, + 157 ERRMSG 9, + 158 ERRMSG 11, + 159 ERRMSG 14, + 160 ERRMSG 16, + 161 ERRMSG 19, + 162 ERRMSG 20, + 163 IF _IBM_ + 164 ERRMSG 24, + 165 ERRMSG 25, + 166 ERRMSG 27, + 167 ENDIF + 168 ERRMSG 50, + 169 ERRMSG 51, + 170 ERRMSG 52, + 171 ERRMSG 53, + 172 ERRMSG 54, + 173 ERRMSG 55, + 174 ERRMSG 57, + 175 ERRMSG 58, + 176 ERRMSG 61, + 177 ERRMSG 62, + 178 ERRMSG 63, + 179 ERRMSG 64, + 180 ERRMSG 67, + 181 ERRMSG 68, + 182 IF _MSDOS_ + 183 IF _IBM_ + 184 ERRMSG 69, + 185 ENDIF + 186 ERRMSG 70, + 187 ERRMSG 71, + 188 ERRMSG 72, + 189 ENDIF + 190 ERRMSG 255, + 191 + 192 01FB CODE ENDS + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 3-1 + + + + 193 + 194 + 195 01FB CODE SEGMENT BYTE PUBLIC 'CODE' + 196 + 197 PUBLIC $DS0,$DS1,$USRA + 198 PUBLIC $DIV0_INT,$OVRF_INT + 199 + 200 PUBLIC $CLR,$CLX + 201 PUBLIC $FOE,$RTE,$CONT,$ERRPR,$INI0,$431,$531,$RET,$NUL + 202 PUBLIC $STP,$BREAK,$END,$$PLNM,$GETAD,$ENP + 203 PUBLIC $$FSFA,$FSERR + 204 + 205 PUBLIC $ERR_RG, $ERR_TM, $ERR_BS, $ERR_RE, $ERR_OS, $ERR_ST + 206 PUBLIC $ERR_OV, $ERR_FC, $ERR_OD, $ERR_OM, $ERR_SN + 207 PUBLIC $ERC_RG, $ERC_TM, $ERC_BS, $ERC_RE, $ERC_OS, $ERC_ST + 208 PUBLIC $ERC_OV, $ERC_FC, $ERC_OD, $ERC_OM, $ERC_SN + 209 + 210 PUBLIC $OVFL, $DIV0 ;**************** Temporary entry points + 211 + 212 PUBLIC $ERR_FOV, $ERR_INT, $ERR_IFN, $ERR_FNF, $ERR_BFM + 213 PUBLIC $ERR_FAO, $ERR_IOE, $ERR_FAE, $ERR_DFL, $ERR_RPE + 214 PUBLIC $ERR_BRN, $ERR_BFN, $ERR_TMF + 215 PUBLIC $ERC_FOV, $ERC_INT, $ERC_IFN, $ERC_FNF, $ERC_BFM + 216 PUBLIC $ERC_FAO, $ERC_IOE, $ERC_FAE, $ERC_DFL, $ERC_RPE + 217 PUBLIC $ERC_BRN, $ERC_BFN, $ERC_TMF + 218 PUBLIC $ERC_DNA, $ERR_DNA + 219 + 220 IF _MSDOS_ + 221 IF _IBM_ + 222 PUBLIC $ERC_DTO, $ERC_DVF, $ERC_OTP + 223 PUBLIC $ERC_CBO + 224 PUBLIC $ERR_DTO, $ERR_DVF, $ERR_OTP + 225 PUBLIC $ERR_CBO + 226 ENDIF + 227 PUBLIC $ERR_FWP, $ERR_DNR, $ERR_DME + 228 PUBLIC $ERC_FWP, $ERC_DNR, $ERC_DME + 229 ENDIF + 230 + 231 EXTRN $ABEND:NEAR + 232 EXTRN $$DTS:NEAR, $OSEXT:NEAR, $$WCHT:NEAR, $$STSU:NEAR + 233 EXTRN $TYPTX:NEAR, $TYTX:NEAR, $$TCR:NEAR, $$THB:NEAR + 234 EXTRN $IOINI:NEAR, $TYPUI:NEAR + 235 EXTRN $INIDEV:NEAR, $CLSDEV:NEAR, $CLOSF:NEAR + 236 + 237 ASSUME CS:CODE, DS:DC, ES:DC + 238 + 239 C INCLUDE LIBMAC.LIB + 240 C ; BASLIB-86 helper macros + 241 C + 242 = 0001 C LXIOK EQU 1 ;1 to allow LXI tricks, 0 to avoid them + 243 C + 244 C SKIP MACRO LENGTH + 245 C + 246 C IF LXIOK ;;OK to use LXI trick? + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 3-2 + + + + 247 C IF LENGTH EQ 1 ;;Is length 1? + 248 C DB 0B0H ;MOV AL,immediate + 249 C ENDIF + 250 C IF LENGTH EQ 2 ;;Is length 2? + 251 C DB 0B8H ;MOV AX,immediate + 252 C ENDIF + 253 C IF LENGTH GT 2 + 254 C ILLEGAL SKIP LENGTH ;Cause an error + 255 C ENDIF + 256 C ELSE ;Don't use LXI tricks + 257 C JMP SHORT $+LENGTH+2 + 258 C + 259 C ENDIF + 260 C + 261 C ENDM + 262 C + 263 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 3-3 + + + + 264 PAGE + 265 + 266 ;*** $INI0 - Initialize run-time system + 267 ; + 268 + 269 01FB $INI0 PROC FAR + 270 01FB 58 POP AX + 271 01FC 5B POP BX ;Recover segment of main program + 272 01FD 89 26 0022 R MOV [$$STKP],SP + 273 0201 53 PUSH BX + 274 0202 50 PUSH AX + 275 0203 89 1E 0026 R MOV [MAINCS],BX + 276 0207 2D 0013 SUB AX,14+5 ;Size of table and init call + 277 020A A3 0024 R MOV [$MAINBASE],AX + 278 020D C7 06 001E R 0340 R MOV [$$ERRV],OFFSET $CONT + 279 + 280 ; Clear user data variables + 281 + 282 0213 E8 0269 R CALL $GETAD + 283 0216 06 DB O_RAM + 284 0217 97 XCHG AX,DI + 285 0218 E8 0269 R CALL $GETAD + 286 021B 0C DB O_RAL + 287 021C 91 XCHG AX,CX + 288 021D 2B CF SUB CX,DI + 289 021F 33 C0 XOR AX,AX + 290 0221 F3/ AA REP STOSB + 291 + 292 0223 BF 0028 R MOV DI,OFFSET DC:STARTZERO + 293 0226 B9 0013 MOV CX,STOPZERO-STARTZERO + 294 0229 F3/ AA REP STOSB ;Zero library variables + 295 + 296 022B 48 DEC AX ;(AX) = -1 + 297 022C B9 000A MOV CX,10 + 298 022F BF 0002 R MOV DI,OFFSET DC:$USR + 299 0232 F3/ AB REP STOSW ;Initialize $USR address vectors + 300 + 301 ; Move constants and data statements from INIT to DATA + 302 + 303 0234 1E PUSH DS + 304 0235 06 PUSH ES + 305 0236 B8 ---- R MOV AX,BC_ICN ;Get base segment addresses + 306 0239 8E D8 MOV DS,AX + 307 023B B8 ---- R MOV AX,BC_CN + 308 023E 8E C0 MOV ES,AX + 309 0240 B9 0000 R MOV CX,(OFFSET END_ICN) + 310 0243 BB 0000 R MOV BX,(OFFSET END_IDS) + 311 0246 03 CB ADD CX,BX + 312 0248 33 F6 XOR SI,SI + 313 024A 33 FF XOR DI,DI + 314 024C F3/ A4 REP MOVSB + 315 024E 07 POP ES + 316 024F 1F POP DS + 317 + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 3-4 + + + + 318 0250 E8 0000 E CALL $$STSU ;Set up string space + 319 0253 E8 0000 E CALL $IOINI ;I/O init + 320 0256 E8 0000 E CALL $INIDEV ;Initialize devices + 321 + 322 ;** $DS0 - Set BASIC Segment Address to Data Segment + 323 + 324 0259 8C 1E 0000 R $DS0: MOV $SEG,DS ;Save initial data seg + 325 + 326 025D $CLR: ;************** For now ************** + 327 025D $CLX: ;************** ************** + 328 025D $NUL: ;************** For now ************** + 329 025D $RET: + 330 025D $431: + 331 025D CB $531: RET + 332 + 333 + 334 ;** $DS1 - Set BASIC Segment Address + 335 ; + 336 ; ENTRY (BX) = new segment address + 337 + 338 025E 89 1E 0000 R $DS1: MOV $SEG,BX ;Save new $SEG value + 339 0262 CB RET + 340 + 341 + 342 ;** $USRA - Call user defined routine + 343 ; + 344 ; ENTRY (BX) = offset address of user routine + 345 + 346 0263 FF 36 0000 R $USRA: PUSH [$SEG] ;Save $SEG value + 347 0267 53 PUSH BX ;Save offset address + 348 0268 CB RET ;Call by long RET + 349 + 350 0269 $INI0 ENDP + 351 + 352 + 353 0269 $GETAD: + 354 0269 5E POP SI + 355 026A 2E: AC LODS BYTE PTR CS:[SI] ;Get byte indicating which address + 356 026C 98 CBW + 357 026D 56 PUSH SI + 358 026E 1E PUSH DS + 359 026F C5 36 0024 R LDS SI,[CBASE] + 360 0273 03 F0 ADD SI,AX + 361 0275 AD LODSW + 362 0276 1F POP DS + 363 0277 C3 RET + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 4-1 + + + + 364 + 365 + 366 ;** 8086 Error interrupt vector + 367 + 368 0278 $DIV0_INT: + 369 0278 58 POP AX + 370 0279 5B POP BX + 371 027A 9D POPF ;Restore interrupt status + 372 027B 53 PUSH BX + 373 027C 50 PUSH AX + 374 027D EB 79 90 JMP $ERR_DV0 ;Divide by 0 error + 375 + 376 0280 $OVRF_INT: + 377 0280 58 POP AX + 378 0281 5B POP BX + 379 0282 9D POPF ;Restore interrupt status + 380 0283 53 PUSH BX + 381 0284 50 PUSH AX + 382 0285 EB 68 90 JMP $ERR_OV ;Overflow error + 383 + 384 + 385 ;*** Error entry points + 386 + 387 ; This group assumes a clean stack value has been saved in $$SPSV. This saved + 388 ; value is restored. + 389 + 390 + 391 ERRMAC MACRO func,noskip + 392 MOV BL,func + 393 ifb + 394 SKIP 2 + 395 endif + 396 ENDM + 397 + 398 + 399 + 400 0288 $ERC_SN: ERRMAC 2 + 401 028B $ERC_RG: ERRMAC 3 + 402 028E $ERC_OD: ERRMAC 4 + 403 0291 $ERC_FC: ERRMAC 5 + 404 0294 $OVFL: ;;Temporary entry point + 405 0294 $ERC_OV: ERRMAC 6 + 406 0297 $ERC_OM: ERRMAC 7 + 407 029A $ERC_BS: ERRMAC 9 + 408 029D $DIV0: ERRMAC 11 ;;Temporary entry point + 409 02A0 $ERC_TM: ERRMAC 13 + 410 02A3 $ERC_OS: ERRMAC 14 + 411 02A6 $ERC_ST: ERRMAC 16 + 412 02A9 $ERC_RE: ERRMAC 20 + 413 IF _IBM_ + 414 $ERC_DTO: ERRMAC 24 + 415 $ERC_DVF: ERRMAC 25 + 416 $ERC_OTP: ERRMAC 27 + 417 ENDIF + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 4-2 + + + + 418 + 419 02AC $ERC_FOV: ERRMAC 50 + 420 02AF $ERC_INT: ERRMAC 51 + 421 02B2 $ERC_IFN: ERRMAC 52 + 422 02B5 $ERC_FNF: ERRMAC 53 + 423 02B8 $ERC_BFM: ERRMAC 54 + 424 02BB $ERC_FAO: ERRMAC 55 + 425 02BE $ERC_IOE: ERRMAC 57 + 426 02C1 $ERC_FAE: ERRMAC 58 + 427 02C4 $ERC_DFL: ERRMAC 61 + 428 02C7 $ERC_RPE: ERRMAC 62 + 429 02CA $ERC_BRN: ERRMAC 63 + 430 02CD $ERC_BFN: ERRMAC 64 + 431 02D0 $ERC_TMF: ERRMAC 67 + 432 IF _MSDOS_ + 433 IF _IBM_ + 434 $ERC_CBO: ERRMAC 69 + 435 ENDIF + 436 02D3 $ERC_FWP: ERRMAC 70 + 437 02D6 $ERC_DNR: ERRMAC 71 + 438 02D9 $ERC_DME: ERRMAC 72 + 439 ENDIF + 440 02DC $ERC_DNA: ERRMAC 68,noskip ;last in chain + 441 + 442 02DE CLNSTK: + 443 02DE 8B 26 0020 R MOV SP,[$$SPSV] ;Restore a clean stack + 444 SKIP 2 + 445 + 446 ; This group has all the same entry points as above, but it assumes stack + 447 ; is at proper level upon entry + 448 + 449 02E3 $ERR_SN: ERRMAC 2 + 450 02E6 $ERR_RG: ERRMAC 3 + 451 02E9 $ERR_OD: ERRMAC 4 + 452 02EC $ERR_FC: ERRMAC 5 + 453 02EF $ERR_OV: ERRMAC 6 + 454 02F2 $ERR_OM: ERRMAC 7 + 455 02F5 $ERR_BS: ERRMAC 9 + 456 02F8 $ERR_DV0: ERRMAC 11 + 457 02FB $ERR_TM: ERRMAC 13 + 458 02FE $ERR_OS: ERRMAC 14 + 459 0301 $ERR_ST: ERRMAC 16 + 460 0304 $ERR_RE: ERRMAC 20 + 461 IF _IBM_ + 462 $ERR_DTO: ERRMAC 24 + 463 $ERR_DVF: ERRMAC 25 + 464 $ERR_OTP: ERRMAC 27 + 465 ENDIF + 466 + 467 0307 $ERR_FOV: ERRMAC 50 + 468 030A $ERR_INT: ERRMAC 51 + 469 030D $ERR_IFN: ERRMAC 52 + 470 0310 $ERR_FNF: ERRMAC 53 + 471 0313 $ERR_BFM: ERRMAC 54 + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 4-3 + + + + 472 0316 $ERR_FAO: ERRMAC 55 + 473 0319 $ERR_IOE: ERRMAC 57 + 474 031C $ERR_FAE: ERRMAC 58 + 475 031F $ERR_DFL: ERRMAC 61 + 476 0322 $ERR_RPE: ERRMAC 62 + 477 0325 $ERR_BRN: ERRMAC 63 + 478 0328 $ERR_BFN: ERRMAC 64 + 479 032B $ERR_TMF: ERRMAC 67 + 480 IF _MSDOS_ + 481 IF _IBM_ + 482 $ERR_CBO: ERRMAC 69 + 483 ENDIF + 484 032E $ERR_FWP: ERRMAC 70 + 485 0331 $ERR_DNR: ERRMAC 71 + 486 0334 $ERR_DME: ERRMAC 72 + 487 ENDIF + 488 0337 $ERR_DNA: ERRMAC 68,noskip ;last in chain + 489 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 4-4 + + + + 490 PAGE + 491 + 492 ;*** $FOE/$RTE - Process Run-Time Error + 493 ; + 494 ; Inputs: + 495 ; BL = Error code + 496 ; Top of stack has address in compiled code + 497 ; Function: + 498 ; If special error handling is needed, a jump to the address in $$ERRV + 499 ; will be made; otherwise, if ON ERROR GOTO has been specified but is not + 500 ; currently processing an error, it will be activated; otherwise, bitch + 501 ; and exit. + 502 ; Outputs: + 503 ; None. Does not return, but will jump to [$$ERRV], ON ERROR, or exit. + 504 ; Registers: + 505 ; All registers trashed. + 506 + 507 0339 Error_trap PROC FAR + 508 + 509 0339 $FOE: + 510 0339 $RTE: + 511 0339 E8 0000 E CALL $$DTS ;Delete all temp strings + 512 ;Execute special error handling if needed. If it is not needed, $$ERRV must + 513 ;contain $CONT so that normal processing will just continue. + 514 033C FF 26 001E R JMP [$$ERRV] + 515 0340 $CONT: + 516 0340 80 3E 0039 R 00 CMP [$$OEIP],0 ;ON ERROR in process? + 517 0345 75 27 JNZ RUNERR ;No second chances--report error and exit + 518 0347 83 3E 0034 R 00 CMP [$$AOER],0 ;ON ERROR set? + 519 034C 74 20 JZ RUNERR ;If not, quit + 520 + 521 ; Activate ON ERROR GOTO + 522 + 523 034E 32 FF XOR BH,BH ;Clear high byte + 524 0350 89 1E 002A R MOV [$ERRNUM],BX ;Save error number + 525 0354 58 POP AX ;Get error offset + 526 0355 A3 0028 R MOV [$ERRADR],AX ;Save error address + 527 0358 E8 040F R CALL $$FSFA ;Get statement number of error + 528 035B A3 002C R MOV [$ERRLIN],AX ;Save statement number of error + 529 035E C6 06 0039 R 01 MOV [$$OEIP],1 ;Mark ON ERROR in progress + 530 0363 5E POP SI ;Get error segment + 531 0364 8B 26 0022 R MOV SP,[$$STKP] ;Reset stack to proper level + 532 0368 56 PUSH SI ;Set error segment + 533 0369 FF 36 0034 R PUSH [$$AOER] ;Set error vector as offset + 534 036D CB RET ;Transfer to error routine + 535 036E RUNERR: + 536 036E E8 03E9 R CALL $ERRPR ;Print error + 537 0371 EB 0A JMP SHORT STOP1 + 538 + 539 0373 Error_trap ENDP + 540 + 541 + 542 ;*** $STP and $END + 543 ; + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 4-5 + + + + 544 ; Print message (STOP only), close files, and exit + 545 + 546 0373 E8 0000 E $STP: CALL $$TCR + 547 TYPMSG + 548 037D STOP1: + 549 037D E8 039B R CALL $$PLNM ;Print line number of stop + 550 0380 $BREAK: + 551 0380 F9 STC + 552 0381 EB 0A JMP SHORT end1 + 553 + 554 ;** $ENP - End of program + 555 + 556 0383 $ENP: + 557 0383 B3 13 MOV BL,19 ;Assume No RESUME error + 558 0385 80 3E 0039 R 00 CMP [$$OEIP],0 ;Is error in progress? + 559 038A 75 E2 JNZ RUNERR ;Yes - give error - No RESUME + 560 + 561 038C $END: + 562 038C F8 CLC + 563 + 564 038D 9C end1: PUSHF + 565 038E E8 0000 E CALL $$TCR ;Print CR/LF + 566 0391 E8 0000 E CALL $CLOSF ;Close all files + 567 0394 E8 0000 E CALL $CLSDEV ;Close all devices + 568 0397 9D POPF + 569 0398 E9 0000 E JMP $OSEXT ;Exit back to O.S. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 5-1 + + + + 570 + 571 + 572 ;*** $$PLNM - Print line number message + 573 ; + 574 ; Inputs: + 575 ; Top of stack has return address, then IP and CS to print. + 576 ; Function: + 577 ; Print address in hex, after " at address ". + 578 ; Outputs: + 579 ; None. + 580 ; Registers: + 581 ; All registers destroyed. + 582 + 583 039B $$PLNM: + 584 039B E8 0269 R CALL $GETAD ;Get address of statement address/number table + 585 039E 00 DB O_STA + 586 039F 0B C0 OR AX,AX + 587 03A1 74 19 JZ plnm5 ;No table + 588 + 589 TYPMSG < in line > + 590 03AF 5D POP BP ;Return address + 591 03B0 58 POP AX ;IP + 592 03B1 5A POP DX ;CS + 593 03B2 55 PUSH BP + 594 03B3 E8 040F R CALL $$FSFA ;Find line number for address (AX) + 595 03B6 E8 0000 E CALL $TYPUI ;Print it to console + 596 03B9 E9 0000 E JMP $$TCR ;Output CR/LF + 597 + 598 03BC plnm5: TYPMSG < at address > + 599 03CB 5D POP BP ;Return address + 600 03CC 5F POP DI ;IP + 601 03CD 5A POP DX ;CS + 602 03CE 55 PUSH BP ;Return address back on stack + 603 03CF E8 03DF R CALL HEXWORD + 604 03D2 B0 3A MOV AL,":" ;Separate segment and offset + 605 03D4 E8 0000 E CALL $$WCHT + 606 03D7 8B D7 MOV DX,DI + 607 03D9 E8 03DF R CALL HEXWORD + 608 03DC E9 0000 E JMP $$TCR + 609 + 610 03DF HEXWORD: + 611 03DF 8A C6 MOV AL,DH + 612 03E1 E8 0000 E CALL $$THB ;Print hex byte + 613 03E4 8A C2 MOV AL,DL + 614 03E6 E9 0000 E JMP $$THB + 615 + 616 03E9 $ERRPR: + 617 ;Print error message given standard error code in BL + 618 03E9 E8 0000 E CALL $$TCR ;Print CR/LF + 619 03EC 06 PUSH ES + 620 03ED 0E PUSH CS + 621 03EE 07 POP ES ;Set ES to code segment + 622 03EF BF 0000 R MOV DI, OFFSET ERRTAB + 623 03F2 8A C3 MOV AL,BL + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 5-2 + + + + 624 03F4 B4 80 MOV AH,80H + 625 03F6 CHKERR: + 626 03F6 26: 80 3D FF CMP BYTE PTR ES:[DI],-1 ;See if end of list + 627 03FA 74 0C JZ PRNERR1 + 628 03FC AE SCASB ;Compare error code byte + 629 03FD 74 0A JZ PRNERR + 630 03FF 86 C4 XCHG AL,AH ;Scan for code >=80H + 631 0401 EATMES: + 632 0401 AE SCASB + 633 0402 73 FD JAE EATMES + 634 0404 86 C4 XCHG AL,AH + 635 0406 EB EE JMP CHKERR + 636 + 637 0408 PRNERR1: + 638 0408 47 INC DI + 639 0409 PRNERR: + 640 0409 07 POP ES + 641 040A 8B F7 MOV SI,DI + 642 040C E9 0000 E JMP $TYTX + 643 + 644 + 645 ;*** $$FSFA - Find statement number from address + 646 ; + 647 ; Inputs: + 648 ; AX = return address into user program + 649 ; Outputs: + 650 ; AX = Statement number + 651 ; BX = Address of start of statement + 652 ; Registers: + 653 ; All destroyed + 654 + 655 040F $$FSFA: ;Find statement number from address in (AX) + 656 040F 91 XCHG AX,CX ;(CX) = original return address + 657 0410 E8 0269 R CALL $GETAD ;Get statement number address table + 658 0413 00 DB O_STA + 659 0414 96 XCHG AX,SI ;(SI) = statement address table + 660 0415 8E 1E 0026 R MOV DS,[MAINCS] ;(DS) = user program segment + 661 0419 33 DB XOR BX,BX ;(BX) = 0 (current closest address) + 662 + 663 041B AD fsfalp: LODSW ;(AX) = next address to check + 664 041C 0B C0 OR AX,AX ;Check if end of table + 665 041E 74 11 JZ fsfend ; Yes + 666 + 667 0420 3B C1 CMP AX,CX ;Are we less than original address + 668 0422 73 09 JAE fsfnxt ; No - skip this one + 669 0424 3B C3 CMP AX,BX ;Are we above the current closest address + 670 0426 72 05 JB fsfnxt ; No - skip this one + 671 + 672 0428 93 XCHG AX,BX ;(BX) = new closest address + 673 0429 AD LODSW ;Get statement number + 674 042A 92 XCHG AX,DX ;Save it in (DX) + 675 042B EB EE JMP fsfalp ;Keep looping + 676 + 677 042D 46 fsfnxt: INC SI ;Skip statement number + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Page 5-3 + + + + 678 042E 46 INC SI + 679 042F EB EA JMP fsfalp ;Keep looping + 680 + 681 0431 06 fsfend: PUSH ES ;Restore DS + 682 0432 1F POP DS + 683 0433 0B DB OR BX,BX ;Test if line number found + 684 0435 74 02 JE $FSERR ; No + 685 0437 92 XCHG Ax,DX ;(AX) = statement number + 686 0438 C3 RET + 687 + 688 0439 $FSERR: ;Have an internal error + 689 TYPMSG + 690 045B E8 0000 E CALL $$TCR ;Output CR/LF + 691 045E E9 0000 E JMP $ABEND ;Just die + 692 + 693 + 694 0461 CODE ENDS + 695 + 696 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Symbols-1 + + + + +Macros: + + N a m e Length + +ERRMAC . . . . . . . . . . . . . 0002 +ERRMSG . . . . . . . . . . . . . 0004 +SKIP . . . . . . . . . . . . . . 0006 +TYPMSG . . . . . . . . . . . . . 0004 + +Segments and groups: + + N a m e Size align combine class + +BC_ICN . . . . . . . . . . . . . 0000 WORD PUBLIC 'INIT' +BC_IDS . . . . . . . . . . . . . 0000 BYTE PUBLIC 'INIT' +CODE . . . . . . . . . . . . . . 0461 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + BC_CN. . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + BC_DS. . . . . . . . . . . . . . 0000 BYTE PUBLIC 'DATA' + DATA . . . . . . . . . . . . . . 003B WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +CBASE. . . . . . . . . . . . . . L DWORD 0024 DATA +CHKERR . . . . . . . . . . . . . L NEAR 03F6 CODE +CLNSTK . . . . . . . . . . . . . L NEAR 02DE CODE +EATMES . . . . . . . . . . . . . L NEAR 0401 CODE +END1 . . . . . . . . . . . . . . L NEAR 038D CODE +END_CN . . . . . . . . . . . . . L BYTE 0000 BC_CN +END_DS . . . . . . . . . . . . . L BYTE 0000 BC_DS +END_ICN. . . . . . . . . . . . . L BYTE 0000 BC_ICN +END_IDS. . . . . . . . . . . . . L BYTE 0000 BC_IDS +ERROR_TRAP . . . . . . . . . . . F PROC 0339 CODE Length =003A +ERRTAB . . . . . . . . . . . . . L BYTE 0000 CODE +FSFALP . . . . . . . . . . . . . L NEAR 041B CODE +FSFEND . . . . . . . . . . . . . L NEAR 0431 CODE +FSFNXT . . . . . . . . . . . . . L NEAR 042D CODE +HEXWORD. . . . . . . . . . . . . L NEAR 03DF CODE +LXIOK. . . . . . . . . . . . . . Number 0001 +MAINCS . . . . . . . . . . . . . L WORD 0026 DATA +O_RAL. . . . . . . . . . . . . . Number 000C +O_RAM. . . . . . . . . . . . . . Number 0006 +O_STA. . . . . . . . . . . . . . Number 0000 +PLNM5. . . . . . . . . . . . . . L NEAR 03BC CODE +PRNERR . . . . . . . . . . . . . L NEAR 0409 CODE +PRNERR1. . . . . . . . . . . . . L NEAR 0408 CODE +RUNERR . . . . . . . . . . . . . L NEAR 036E CODE +STARTDATA. . . . . . . . . . . . Number 0002 +STARTZERO. . . . . . . . . . . . L BYTE 0028 DATA +STOP1. . . . . . . . . . . . . . L NEAR 037D CODE +STOPZERO . . . . . . . . . . . . L BYTE 003B DATA +$$AOER . . . . . . . . . . . . . L WORD 0034 DATA Global + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Symbols-2 + + + +$$DTS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$ERRV . . . . . . . . . . . . . L WORD 001E DATA Global +$$FSFA . . . . . . . . . . . . . L NEAR 040F CODE Global +$$GCNT . . . . . . . . . . . . . L WORD 0036 DATA Global +$$OEIP . . . . . . . . . . . . . L BYTE 0039 DATA Global +$$PLNM . . . . . . . . . . . . . L NEAR 039B CODE Global +$$RSTO . . . . . . . . . . . . . L BYTE 0038 DATA Global +$$SPSV . . . . . . . . . . . . . L WORD 0020 DATA Global +$$STKP . . . . . . . . . . . . . L WORD 0022 DATA Global +$$STSU . . . . . . . . . . . . . L NEAR 0000 CODE External +$$TCR. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$THB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WCHT . . . . . . . . . . . . . L NEAR 0000 CODE External +$431 . . . . . . . . . . . . . . L NEAR 025D CODE Global +$531 . . . . . . . . . . . . . . L NEAR 025D CODE Global +$ABEND . . . . . . . . . . . . . L NEAR 0000 CODE External +$AC. . . . . . . . . . . . . . . L BYTE 001A DATA Global Length =0003 +$BREAK . . . . . . . . . . . . . L NEAR 0380 CODE Global +$CLOSF . . . . . . . . . . . . . L NEAR 0000 CODE External +$CLR . . . . . . . . . . . . . . L NEAR 025D CODE Global +$CLSDEV. . . . . . . . . . . . . L NEAR 0000 CODE External +$CLX . . . . . . . . . . . . . . L NEAR 025D CODE Global +$CONT. . . . . . . . . . . . . . L NEAR 0340 CODE Global +$DAC . . . . . . . . . . . . . . L BYTE 0016 DATA Global Length =0004 +$DIV0. . . . . . . . . . . . . . L NEAR 029D CODE Global +$DIV0_INT. . . . . . . . . . . . L NEAR 0278 CODE Global +$DS0 . . . . . . . . . . . . . . L NEAR 0259 CODE Global +$DS1 . . . . . . . . . . . . . . L NEAR 025E CODE Global +$END . . . . . . . . . . . . . . L NEAR 038C CODE Global +$ENP . . . . . . . . . . . . . . L NEAR 0383 CODE Global +$ERC_BFM . . . . . . . . . . . . L NEAR 02B8 CODE Global +$ERC_BFN . . . . . . . . . . . . L NEAR 02CD CODE Global +$ERC_BRN . . . . . . . . . . . . L NEAR 02CA CODE Global +$ERC_BS. . . . . . . . . . . . . L NEAR 029A CODE Global +$ERC_DFL . . . . . . . . . . . . L NEAR 02C4 CODE Global +$ERC_DME . . . . . . . . . . . . L NEAR 02D9 CODE Global +$ERC_DNA . . . . . . . . . . . . L NEAR 02DC CODE Global +$ERC_DNR . . . . . . . . . . . . L NEAR 02D6 CODE Global +$ERC_FAE . . . . . . . . . . . . L NEAR 02C1 CODE Global +$ERC_FAO . . . . . . . . . . . . L NEAR 02BB CODE Global +$ERC_FC. . . . . . . . . . . . . L NEAR 0291 CODE Global +$ERC_FNF . . . . . . . . . . . . L NEAR 02B5 CODE Global +$ERC_FOV . . . . . . . . . . . . L NEAR 02AC CODE Global +$ERC_FWP . . . . . . . . . . . . L NEAR 02D3 CODE Global +$ERC_IFN . . . . . . . . . . . . L NEAR 02B2 CODE Global +$ERC_INT . . . . . . . . . . . . L NEAR 02AF CODE Global +$ERC_IOE . . . . . . . . . . . . L NEAR 02BE CODE Global +$ERC_OD. . . . . . . . . . . . . L NEAR 028E CODE Global +$ERC_OM. . . . . . . . . . . . . L NEAR 0297 CODE Global +$ERC_OS. . . . . . . . . . . . . L NEAR 02A3 CODE Global +$ERC_OV. . . . . . . . . . . . . L NEAR 0294 CODE Global +$ERC_RE. . . . . . . . . . . . . L NEAR 02A9 CODE Global +$ERC_RG. . . . . . . . . . . . . L NEAR 028B CODE Global +$ERC_RPE . . . . . . . . . . . . L NEAR 02C7 CODE Global + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Symbols-3 + + + +$ERC_SN. . . . . . . . . . . . . L NEAR 0288 CODE Global +$ERC_ST. . . . . . . . . . . . . L NEAR 02A6 CODE Global +$ERC_TM. . . . . . . . . . . . . L NEAR 02A0 CODE Global +$ERC_TMF . . . . . . . . . . . . L NEAR 02D0 CODE Global +$ERRADR. . . . . . . . . . . . . L WORD 0028 DATA Global +$ERRLIN. . . . . . . . . . . . . L WORD 002C DATA Global +$ERRNUM. . . . . . . . . . . . . L WORD 002A DATA Global +$ERRPR . . . . . . . . . . . . . L NEAR 03E9 CODE Global +$ERR_BFM . . . . . . . . . . . . L NEAR 0313 CODE Global +$ERR_BFN . . . . . . . . . . . . L NEAR 0328 CODE Global +$ERR_BRN . . . . . . . . . . . . L NEAR 0325 CODE Global +$ERR_BS. . . . . . . . . . . . . L NEAR 02F5 CODE Global +$ERR_DFL . . . . . . . . . . . . L NEAR 031F CODE Global +$ERR_DME . . . . . . . . . . . . L NEAR 0334 CODE Global +$ERR_DNA . . . . . . . . . . . . L NEAR 0337 CODE Global +$ERR_DNR . . . . . . . . . . . . L NEAR 0331 CODE Global +$ERR_DV0 . . . . . . . . . . . . L NEAR 02F8 CODE +$ERR_FAE . . . . . . . . . . . . L NEAR 031C CODE Global +$ERR_FAO . . . . . . . . . . . . L NEAR 0316 CODE Global +$ERR_FC. . . . . . . . . . . . . L NEAR 02EC CODE Global +$ERR_FNF . . . . . . . . . . . . L NEAR 0310 CODE Global +$ERR_FOV . . . . . . . . . . . . L NEAR 0307 CODE Global +$ERR_FWP . . . . . . . . . . . . L NEAR 032E CODE Global +$ERR_IFN . . . . . . . . . . . . L NEAR 030D CODE Global +$ERR_INT . . . . . . . . . . . . L NEAR 030A CODE Global +$ERR_IOE . . . . . . . . . . . . L NEAR 0319 CODE Global +$ERR_OD. . . . . . . . . . . . . L NEAR 02E9 CODE Global +$ERR_OM. . . . . . . . . . . . . L NEAR 02F2 CODE Global +$ERR_OS. . . . . . . . . . . . . L NEAR 02FE CODE Global +$ERR_OV. . . . . . . . . . . . . L NEAR 02EF CODE Global +$ERR_RE. . . . . . . . . . . . . L NEAR 0304 CODE Global +$ERR_RG. . . . . . . . . . . . . L NEAR 02E6 CODE Global +$ERR_RPE . . . . . . . . . . . . L NEAR 0322 CODE Global +$ERR_SN. . . . . . . . . . . . . L NEAR 02E3 CODE Global +$ERR_ST. . . . . . . . . . . . . L NEAR 0301 CODE Global +$ERR_TM. . . . . . . . . . . . . L NEAR 02FB CODE Global +$ERR_TMF . . . . . . . . . . . . L NEAR 032B CODE Global +$FAC . . . . . . . . . . . . . . L BYTE 001D DATA Global +$FILPT . . . . . . . . . . . . . L WORD 0030 DATA Global +$FOE . . . . . . . . . . . . . . L NEAR 0339 CODE Global +$FREPT . . . . . . . . . . . . . L WORD 002E DATA Global +$FSERR . . . . . . . . . . . . . L NEAR 0439 CODE Global +$GETAD . . . . . . . . . . . . . L NEAR 0269 CODE Global +$INI0. . . . . . . . . . . . . . F PROC 01FB CODE Global Length =006E +$INIDEV. . . . . . . . . . . . . L NEAR 0000 CODE External +$IOINI . . . . . . . . . . . . . L NEAR 0000 CODE External +$MAINBASE. . . . . . . . . . . . L WORD 0024 DATA Global +$NUL . . . . . . . . . . . . . . L NEAR 025D CODE Global +$OSEXT . . . . . . . . . . . . . L NEAR 0000 CODE External +$OVFL. . . . . . . . . . . . . . L NEAR 0294 CODE Global +$OVRF_INT. . . . . . . . . . . . L NEAR 0280 CODE Global +$PTRFIL. . . . . . . . . . . . . L WORD 0032 DATA Global +$RET . . . . . . . . . . . . . . L NEAR 025D CODE Global +$RTE . . . . . . . . . . . . . . L NEAR 0339 CODE Global + + +GOSTOP - Initialization, STOP, END, and error processing Macro-86 %1(12) 1:1:43 13-Nov-81 Symbols-4 + + + +$SEG . . . . . . . . . . . . . . L WORD 0000 DATA Global +$STP . . . . . . . . . . . . . . L NEAR 0373 CODE Global +$TRACE_SW. . . . . . . . . . . . L BYTE 003A DATA Global +$TYPTX . . . . . . . . . . . . . L NEAR 0000 CODE External +$TYPUI . . . . . . . . . . . . . L NEAR 0000 CODE External +$TYTX. . . . . . . . . . . . . . L NEAR 0000 CODE External +$USR . . . . . . . . . . . . . . L WORD 0002 DATA Global Length =000A +$USRA. . . . . . . . . . . . . . L NEAR 0263 CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +__PCHR . . . . . . . . . . . . . Number 0072 + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/GOSTOP.ASM b/3_source_code/BASLIB-86/GOSTOP.ASM new file mode 100644 index 0000000..9671ada --- /dev/null +++ b/3_source_code/BASLIB-86/GOSTOP.ASM @@ -0,0 +1,631 @@ + TITLE GOSTOP - Initialization, STOP, END, and error processing + +.sall + INCLUDE SYSTEM.INC + INCLUDE ADDR.INC + + +ERRMSG MACRO Errnum,Errtxt + .xcref +__Pchr = 0 + DB Errnum + IRPC chr, +IF __Pchr + DB &__Pchr + ENDIF +__Pchr = "&chr" + ENDM + DB __Pchr+128 + .cref + ENDM + +TYPMSG MACRO Txt +__Pchr = 0 + CALL $TYPTX ;;Print Following string to CON + IRPC chr, +IF __Pchr + DB &__Pchr + ENDIF +__Pchr = "&chr" + ENDM + DB __Pchr+128 + ENDM + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC $SEG,$USR + + PUBLIC $DAC,$AC,$FAC + PUBLIC $$ERRV,$$SPSV,$$STKP,$MAINBASE + +$SEG DW ? +$USR DW 10 DUP (?) + +$DAC DB 4 DUP(?) +$AC DB 3 DUP(?) +$FAC DB ? + +$$ERRV DW ? ;Special error handler address +$$SPSV DW ? ;Save stack here +$$STKP DW ? + +CBASE LABEL DWORD +$MAINBASE DW ? ;Starting offset of main +MAINCS DW ? ;CS of main program + +DATA ENDS + +DATA SEGMENT WORD PUBLIC 'DATA' + +;This data area is zeroed on initialization and each CLEAR + + PUBLIC $FREPT,$FILPT,$PTRFIL,$$AOER,$$OEIP,$$RSTO + PUBLIC $ERRNUM,$ERRLIN,$ERRADR,$$GCNT + PUBLIC $TRACE_SW + +STARTZERO LABEL BYTE + +$ERRADR DW ? ;Error address +$ERRNUM DW ? ;Error number +$ERRLIN DW ? ;Error line + +$FREPT DW ? ;File block free list +$FILPT DW ? ;Active file list +$PTRFIL DW ? ;Current file pointer +$$AOER DW ? ;ON ERROR address +$$GCNT DW ? ;GOSUB count +$$RSTO DB ? ;Has RESTORE occurred yet? +$$OEIP DB ? ;ON ERROR in progress +$TRACE_SW DB ? ;Trace switch + +STOPZERO LABEL BYTE + +DATA ENDS + + +BC_CN SEGMENT WORD PUBLIC 'DATA' +END_CN LABEL BYTE +BC_CN ENDS + +BC_DS SEGMENT BYTE PUBLIC 'DATA' +END_DS LABEL BYTE +BC_DS ENDS + +DC GROUP BC_CN,BC_DS,DATA + + +BC_ICN SEGMENT WORD PUBLIC 'INIT' +END_ICN LABEL BYTE +BC_ICN ENDS + +BC_IDS SEGMENT BYTE PUBLIC 'INIT' +END_IDS LABEL BYTE +BC_IDS ENDS + + +CODE SEGMENT BYTE PUBLIC 'CODE' + +ERRTAB LABEL BYTE + ERRMSG 2, + ERRMSG 3, + ERRMSG 4, + ERRMSG 5, + ERRMSG 6, + ERRMSG 7, + ERRMSG 9, + ERRMSG 11, + ERRMSG 14, + ERRMSG 16, + ERRMSG 19, + ERRMSG 20, +IF _IBM_ + ERRMSG 24, + ERRMSG 25, + ERRMSG 27, +ENDIF + ERRMSG 50, + ERRMSG 51, + ERRMSG 52, + ERRMSG 53, + ERRMSG 54, + ERRMSG 55, + ERRMSG 57, + ERRMSG 58, + ERRMSG 61, + ERRMSG 62, + ERRMSG 63, + ERRMSG 64, + ERRMSG 67, + ERRMSG 68, +IF _MSDOS_ + IF _IBM_ + ERRMSG 69, + ENDIF + ERRMSG 70, + ERRMSG 71, + ERRMSG 72, +ENDIF + ERRMSG 255, + +CODE ENDS + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $DS0,$DS1,$USRA + PUBLIC $DIV0_INT,$OVRF_INT + + PUBLIC $CLR,$CLX + PUBLIC $FOE,$RTE,$CONT,$ERRPR,$INI0,$431,$531,$RET,$NUL + PUBLIC $STP,$BREAK,$END,$$PLNM,$GETAD,$ENP + PUBLIC $$FSFA,$FSERR + + PUBLIC $ERR_RG, $ERR_TM, $ERR_BS, $ERR_RE, $ERR_OS, $ERR_ST + PUBLIC $ERR_OV, $ERR_FC, $ERR_OD, $ERR_OM, $ERR_SN + PUBLIC $ERC_RG, $ERC_TM, $ERC_BS, $ERC_RE, $ERC_OS, $ERC_ST + PUBLIC $ERC_OV, $ERC_FC, $ERC_OD, $ERC_OM, $ERC_SN + + PUBLIC $OVFL, $DIV0 ;**************** Temporary entry points + + PUBLIC $ERR_FOV, $ERR_INT, $ERR_IFN, $ERR_FNF, $ERR_BFM + PUBLIC $ERR_FAO, $ERR_IOE, $ERR_FAE, $ERR_DFL, $ERR_RPE + PUBLIC $ERR_BRN, $ERR_BFN, $ERR_TMF + PUBLIC $ERC_FOV, $ERC_INT, $ERC_IFN, $ERC_FNF, $ERC_BFM + PUBLIC $ERC_FAO, $ERC_IOE, $ERC_FAE, $ERC_DFL, $ERC_RPE + PUBLIC $ERC_BRN, $ERC_BFN, $ERC_TMF + PUBLIC $ERC_DNA, $ERR_DNA + +IF _MSDOS_ +IF _IBM_ + PUBLIC $ERC_DTO, $ERC_DVF, $ERC_OTP + PUBLIC $ERC_CBO + PUBLIC $ERR_DTO, $ERR_DVF, $ERR_OTP + PUBLIC $ERR_CBO +ENDIF + PUBLIC $ERR_FWP, $ERR_DNR, $ERR_DME + PUBLIC $ERC_FWP, $ERC_DNR, $ERC_DME +ENDIF + + EXTRN $ABEND:NEAR + EXTRN $$DTS:NEAR, $OSEXT:NEAR, $$WCHT:NEAR, $$STSU:NEAR + EXTRN $TYPTX:NEAR, $TYTX:NEAR, $$TCR:NEAR, $$THB:NEAR + EXTRN $IOINI:NEAR, $TYPUI:NEAR + EXTRN $INIDEV:NEAR, $CLSDEV:NEAR, $CLOSF:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + INCLUDE LIBMAC.LIB + + PAGE + +;*** $INI0 - Initialize run-time system +; + +$INI0 PROC FAR + POP AX + POP BX ;Recover segment of main program + MOV [$$STKP],SP + PUSH BX + PUSH AX + MOV [MAINCS],BX + SUB AX,14+5 ;Size of table and init call + MOV [$MAINBASE],AX + MOV [$$ERRV],OFFSET $CONT + +; Clear user data variables + + CALL $GETAD + DB O_RAM + XCHG AX,DI + CALL $GETAD + DB O_RAL + XCHG AX,CX + SUB CX,DI + XOR AX,AX + REP STOSB + + MOV DI,OFFSET DC:STARTZERO + MOV CX,STOPZERO-STARTZERO + REP STOSB ;Zero library variables + + DEC AX ;(AX) = -1 + MOV CX,10 + MOV DI,OFFSET DC:$USR + REP STOSW ;Initialize $USR address vectors + +; Move constants and data statements from INIT to DATA + + PUSH DS + PUSH ES + MOV AX,BC_ICN ;Get base segment addresses + MOV DS,AX + MOV AX,BC_CN + MOV ES,AX + MOV CX,(OFFSET END_ICN) + MOV BX,(OFFSET END_IDS) + ADD CX,BX + XOR SI,SI + XOR DI,DI + REP MOVSB + POP ES + POP DS + + CALL $$STSU ;Set up string space + CALL $IOINI ;I/O init + CALL $INIDEV ;Initialize devices + +;** $DS0 - Set BASIC Segment Address to Data Segment + +$DS0: MOV $SEG,DS ;Save initial data seg + +$CLR: ;************** For now ************** +$CLX: ;************** ************** +$NUL: ;************** For now ************** +$RET: +$431: +$531: RET + + +;** $DS1 - Set BASIC Segment Address +; +; ENTRY (BX) = new segment address + +$DS1: MOV $SEG,BX ;Save new $SEG value + RET + + +;** $USRA - Call user defined routine +; +; ENTRY (BX) = offset address of user routine + +$USRA: PUSH [$SEG] ;Save $SEG value + PUSH BX ;Save offset address + RET ;Call by long RET + +$INI0 ENDP + + +$GETAD: + POP SI + LODS BYTE PTR CS:[SI] ;Get byte indicating which address + CBW + PUSH SI + PUSH DS + LDS SI,[CBASE] + ADD SI,AX + LODSW + POP DS + RET + + +;** 8086 Error interrupt vector + +$DIV0_INT: + POP AX + POP BX + POPF ;Restore interrupt status + PUSH BX + PUSH AX + JMP $ERR_DV0 ;Divide by 0 error + +$OVRF_INT: + POP AX + POP BX + POPF ;Restore interrupt status + PUSH BX + PUSH AX + JMP $ERR_OV ;Overflow error + + +;*** Error entry points + +; This group assumes a clean stack value has been saved in $$SPSV. This saved +; value is restored. + + +ERRMAC MACRO func,noskip + MOV BL,func +ifb + SKIP 2 +endif + ENDM + + + +$ERC_SN: ERRMAC 2 +$ERC_RG: ERRMAC 3 +$ERC_OD: ERRMAC 4 +$ERC_FC: ERRMAC 5 +$OVFL: ;;Temporary entry point +$ERC_OV: ERRMAC 6 +$ERC_OM: ERRMAC 7 +$ERC_BS: ERRMAC 9 +$DIV0: ERRMAC 11 ;;Temporary entry point +$ERC_TM: ERRMAC 13 +$ERC_OS: ERRMAC 14 +$ERC_ST: ERRMAC 16 +$ERC_RE: ERRMAC 20 +IF _IBM_ + $ERC_DTO: ERRMAC 24 + $ERC_DVF: ERRMAC 25 + $ERC_OTP: ERRMAC 27 +ENDIF + +$ERC_FOV: ERRMAC 50 +$ERC_INT: ERRMAC 51 +$ERC_IFN: ERRMAC 52 +$ERC_FNF: ERRMAC 53 +$ERC_BFM: ERRMAC 54 +$ERC_FAO: ERRMAC 55 +$ERC_IOE: ERRMAC 57 +$ERC_FAE: ERRMAC 58 +$ERC_DFL: ERRMAC 61 +$ERC_RPE: ERRMAC 62 +$ERC_BRN: ERRMAC 63 +$ERC_BFN: ERRMAC 64 +$ERC_TMF: ERRMAC 67 +IF _MSDOS_ + IF _IBM_ + $ERC_CBO: ERRMAC 69 + ENDIF + $ERC_FWP: ERRMAC 70 + $ERC_DNR: ERRMAC 71 + $ERC_DME: ERRMAC 72 +ENDIF +$ERC_DNA: ERRMAC 68,noskip ;last in chain + +CLNSTK: + MOV SP,[$$SPSV] ;Restore a clean stack + SKIP 2 + +; This group has all the same entry points as above, but it assumes stack +; is at proper level upon entry + +$ERR_SN: ERRMAC 2 +$ERR_RG: ERRMAC 3 +$ERR_OD: ERRMAC 4 +$ERR_FC: ERRMAC 5 +$ERR_OV: ERRMAC 6 +$ERR_OM: ERRMAC 7 +$ERR_BS: ERRMAC 9 +$ERR_DV0: ERRMAC 11 +$ERR_TM: ERRMAC 13 +$ERR_OS: ERRMAC 14 +$ERR_ST: ERRMAC 16 +$ERR_RE: ERRMAC 20 +IF _IBM_ + $ERR_DTO: ERRMAC 24 + $ERR_DVF: ERRMAC 25 + $ERR_OTP: ERRMAC 27 +ENDIF + +$ERR_FOV: ERRMAC 50 +$ERR_INT: ERRMAC 51 +$ERR_IFN: ERRMAC 52 +$ERR_FNF: ERRMAC 53 +$ERR_BFM: ERRMAC 54 +$ERR_FAO: ERRMAC 55 +$ERR_IOE: ERRMAC 57 +$ERR_FAE: ERRMAC 58 +$ERR_DFL: ERRMAC 61 +$ERR_RPE: ERRMAC 62 +$ERR_BRN: ERRMAC 63 +$ERR_BFN: ERRMAC 64 +$ERR_TMF: ERRMAC 67 +IF _MSDOS_ + IF _IBM_ + $ERR_CBO: ERRMAC 69 + ENDIF + $ERR_FWP: ERRMAC 70 + $ERR_DNR: ERRMAC 71 + $ERR_DME: ERRMAC 72 +ENDIF +$ERR_DNA: ERRMAC 68,noskip ;last in chain + + PAGE + +;*** $FOE/$RTE - Process Run-Time Error +; +; Inputs: +; BL = Error code +; Top of stack has address in compiled code +; Function: +; If special error handling is needed, a jump to the address in $$ERRV +; will be made; otherwise, if ON ERROR GOTO has been specified but is not +; currently processing an error, it will be activated; otherwise, bitch +; and exit. +; Outputs: +; None. Does not return, but will jump to [$$ERRV], ON ERROR, or exit. +; Registers: +; All registers trashed. + +Error_trap PROC FAR + +$FOE: +$RTE: + CALL $$DTS ;Delete all temp strings +;Execute special error handling if needed. If it is not needed, $$ERRV must +;contain $CONT so that normal processing will just continue. + JMP [$$ERRV] +$CONT: + CMP [$$OEIP],0 ;ON ERROR in process? + JNZ RUNERR ;No second chances--report error and exit + CMP [$$AOER],0 ;ON ERROR set? + JZ RUNERR ;If not, quit + +; Activate ON ERROR GOTO + + XOR BH,BH ;Clear high byte + MOV [$ERRNUM],BX ;Save error number + POP AX ;Get error offset + MOV [$ERRADR],AX ;Save error address + CALL $$FSFA ;Get statement number of error + MOV [$ERRLIN],AX ;Save statement number of error + MOV [$$OEIP],1 ;Mark ON ERROR in progress + POP SI ;Get error segment + MOV SP,[$$STKP] ;Reset stack to proper level + PUSH SI ;Set error segment + PUSH [$$AOER] ;Set error vector as offset + RET ;Transfer to error routine +RUNERR: + CALL $ERRPR ;Print error + JMP SHORT STOP1 + +Error_trap ENDP + + +;*** $STP and $END +; +; Print message (STOP only), close files, and exit + +$STP: CALL $$TCR + TYPMSG +STOP1: + CALL $$PLNM ;Print line number of stop +$BREAK: + STC + JMP SHORT end1 + +;** $ENP - End of program + +$ENP: + MOV BL,19 ;Assume No RESUME error + CMP [$$OEIP],0 ;Is error in progress? + JNZ RUNERR ;Yes - give error - No RESUME + +$END: + CLC + +end1: PUSHF + CALL $$TCR ;Print CR/LF + CALL $CLOSF ;Close all files + CALL $CLSDEV ;Close all devices + POPF + JMP $OSEXT ;Exit back to O.S. + + +;*** $$PLNM - Print line number message +; +; Inputs: +; Top of stack has return address, then IP and CS to print. +; Function: +; Print address in hex, after " at address ". +; Outputs: +; None. +; Registers: +; All registers destroyed. + +$$PLNM: + CALL $GETAD ;Get address of statement address/number table + DB O_STA + OR AX,AX + JZ plnm5 ;No table + + TYPMSG < in line > + POP BP ;Return address + POP AX ;IP + POP DX ;CS + PUSH BP + CALL $$FSFA ;Find line number for address (AX) + CALL $TYPUI ;Print it to console + JMP $$TCR ;Output CR/LF + +plnm5: TYPMSG < at address > + POP BP ;Return address + POP DI ;IP + POP DX ;CS + PUSH BP ;Return address back on stack + CALL HEXWORD + MOV AL,":" ;Separate segment and offset + CALL $$WCHT + MOV DX,DI + CALL HEXWORD + JMP $$TCR + +HEXWORD: + MOV AL,DH + CALL $$THB ;Print hex byte + MOV AL,DL + JMP $$THB + +$ERRPR: +;Print error message given standard error code in BL + CALL $$TCR ;Print CR/LF + PUSH ES + PUSH CS + POP ES ;Set ES to code segment + MOV DI, OFFSET ERRTAB + MOV AL,BL + MOV AH,80H +CHKERR: + CMP BYTE PTR ES:[DI],-1 ;See if end of list + JZ PRNERR1 + SCASB ;Compare error code byte + JZ PRNERR + XCHG AL,AH ;Scan for code >=80H +EATMES: + SCASB + JAE EATMES + XCHG AL,AH + JMP CHKERR + +PRNERR1: + INC DI +PRNERR: + POP ES + MOV SI,DI + JMP $TYTX + + +;*** $$FSFA - Find statement number from address +; +; Inputs: +; AX = return address into user program +; Outputs: +; AX = Statement number +; BX = Address of start of statement +; Registers: +; All destroyed + +$$FSFA: ;Find statement number from address in (AX) + XCHG AX,CX ;(CX) = original return address + CALL $GETAD ;Get statement number address table + DB O_STA + XCHG AX,SI ;(SI) = statement address table + MOV DS,[MAINCS] ;(DS) = user program segment + XOR BX,BX ;(BX) = 0 (current closest address) + +fsfalp: LODSW ;(AX) = next address to check + OR AX,AX ;Check if end of table + JZ fsfend ; Yes + + CMP AX,CX ;Are we less than original address + JAE fsfnxt ; No - skip this one + CMP AX,BX ;Are we above the current closest address + JB fsfnxt ; No - skip this one + + XCHG AX,BX ;(BX) = new closest address + LODSW ;Get statement number + XCHG AX,DX ;Save it in (DX) + JMP fsfalp ;Keep looping + +fsfnxt: INC SI ;Skip statement number + INC SI + JMP fsfalp ;Keep looping + +fsfend: PUSH ES ;Restore DS + POP DS + OR BX,BX ;Test if line number found + JE $FSERR ; No + XCHG Ax,DX ;(AX) = statement number + RET + +$FSERR: ;Have an internal error + TYPMSG + CALL $$TCR ;Output CR/LF + JMP $ABEND ;Just die + + +CODE ENDS + + END diff --git a/3_source_code/BASLIB-86/LIBMAC.LIB b/3_source_code/BASLIB-86/LIBMAC.LIB new file mode 100644 index 0000000..7045cf7 --- /dev/null +++ b/3_source_code/BASLIB-86/LIBMAC.LIB @@ -0,0 +1,23 @@ +; BASLIB-86 helper macros + +LXIOK EQU 1 ;1 to allow LXI tricks, 0 to avoid them + +SKIP MACRO LENGTH + + IF LXIOK ;;OK to use LXI trick? + IF LENGTH EQ 1 ;;Is length 1? + DB 0B0H ;MOV AL,immediate + ENDIF + IF LENGTH EQ 2 ;;Is length 2? + DB 0B8H ;MOV AX,immediate + ENDIF + IF LENGTH GT 2 + ILLEGAL SKIP LENGTH ;Cause an error + ENDIF + ELSE ;Don't use LXI tricks + JMP SHORT $+LENGTH+2 + + ENDIF + + ENDM + diff --git a/3_source_code/BASLIB-86/SYSTEM.INC b/3_source_code/BASLIB-86/SYSTEM.INC new file mode 100644 index 0000000..37585ea --- /dev/null +++ b/3_source_code/BASLIB-86/SYSTEM.INC @@ -0,0 +1,29 @@ +; Operating System Selection + +_IBM_= 0 + +_MSDOS_= 1 +_CPM_= 0 + +; Overrides + +_MSDOS_= _MSDOS_ or _IBM_ + +if1 +if _CPM_ + %OUT ! CP/M-86 Version +endif +if _MSDOS_ + %OUT ! MSDOS Version +endif +if _IBM_ + %OUT ! IBM Personal Computer +endif + +if _MSDOS_+_CPM_ ne 1 + %OUT ##################### Error - Bad Operating System Selection + + error +endif +endif + From 0c10a1de23ee4ca1ce64c28c1369035d07eb28e9 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 4 Jul 2026 09:05:42 -0700 Subject: [PATCH 25/53] Transcription of Bundle 9 - GOSUB.ASM Code and Listing --- 2_printed_files/bundle_09/GOSUB.ASM | 241 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/GOSUB.ASM | 156 ++++++++++++++++++ 2 files changed, 397 insertions(+) create mode 100644 2_printed_files/bundle_09/GOSUB.ASM create mode 100644 3_source_code/BASLIB-86/GOSUB.ASM diff --git a/2_printed_files/bundle_09/GOSUB.ASM b/2_printed_files/bundle_09/GOSUB.ASM new file mode 100644 index 0000000..6bad85b --- /dev/null +++ b/2_printed_files/bundle_09/GOSUB.ASM @@ -0,0 +1,241 @@ +GOSUB - GOSUB, RETURN, and computed GOSUB/GOTO Macro-86 %1(12) 1:2:59 13-Nov-81 Page 1-1 + + + + 1 TITLE GOSUB - GOSUB, RETURN, and computed GOSUB/GOTO + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $$STKP:WORD + 6 + 7 0000 ???? $$GCNT DW ? + 8 + 9 0002 DATA ENDS + 10 + 11 DC GROUP DATA + 12 + 13 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 14 + 15 PUBLIC $OGSA, $OGTA, $GOSA, $RELA, $RETA + 16 + 17 EXTRN $ERR_FC:NEAR, $ERR_RG:NEAR + 18 + 19 ASSUME CS:CODE, DS:DC, ES:DC + 20 + 21 0000 GOSUB PROC FAR ;Set up long returns + 22 + 23 + 24 ;*** $GOSA - GOSUB with error checking + 25 ; + 26 ; Inputs: + 27 ; Return address on top of stack points to address of target location + 28 ; Function: + 29 ; Execute a near (relative user code) call to the target, saving + 30 ; a clean stack pointer value (for after the call) and bumping the + 31 ; nesting counter for "RETURN without GOSUB" detection. + 32 ; Outputs: + 33 ; None. + 34 ; Registers: + 35 ; Destroys all except BP. + 36 + 37 0000 $GOSA: + 38 0000 5E POP SI + 39 0001 89 26 0000 E MOV [$$STKP],SP ;Save clean stack value + 40 0005 1F POP DS ;DS:SI point to target + 41 0006 AD LODSW + 42 0007 56 PUSH SI ;Push return address + 43 0008 1E PUSH DS + 44 0009 50 PUSH AX ;DS:AX is target, now on top of stack + 45 000A 06 PUSH ES + 46 000B 1F POP DS ;Restore DS + 47 000C FF 06 0000 R INC [$$GCNT] ;Bump nesting level + 48 0010 CB RET ;Long return to target + 49 + 50 + 51 ;*** $RELA - RETURN line number address popper + 52 ; + 53 ; Inputs: + 54 ; None. + + +GOSUB - GOSUB, RETURN, and computed GOSUB/GOTO Macro-86 %1(12) 1:2:59 13-Nov-81 Page 1-2 + + + + 55 ; Function: + 56 ; Pop one entry off the stack and update GOSUB level + 57 ; Outputs: + 58 ; None. + 59 ; Registers: + 60 ; Destroys all except BP. + 61 + 62 0011 $RELA: + 63 0011 FF 0E 0000 R DEC [$$GCNT] ;Decrement count - error if < 0 + 64 0015 78 15 JS ERR_RG ;RETURN without GOSUB error? + 65 0017 5B POP BX ;IP for our return + 66 0018 58 POP AX ;CS of user code + 67 0019 59 POP CX ;Toss this address + 68 001A EB 09 JMP short reta1 + 69 + 70 + 71 ;*** $RETA - RETURN from GOSUB with error checking + 72 ; + 73 ; Inputs: + 74 ; None. + 75 ; Function: + 76 ; Execute near (relative user code) return, checking nesting level to + 77 ; avoid RETURN without GOSUB, and saving post-return clean stack value. + 78 ; Outputs: + 79 ; None. + 80 ; Registers: + 81 ; Destroys all except BP. + 82 + 83 001C $RETA: + 84 001C FF 0E 0000 R DEC [$$GCNT] ;Decrement count - error if < 0 + 85 0020 78 0A JS ERR_RG ;RETURN without GOSUB error? + 86 0022 58 POP AX ;Dump IP for our return + 87 0023 58 POP AX ;CS of user code + 88 0024 5B POP BX ;This is the local return address + 89 + 90 0025 89 26 0000 E reta1: MOV [$$STKP],SP ;Save clean stack level + 91 0029 50 PUSH AX ;Push CS first + 92 002A 53 PUSH BX + 93 002B CB RET ;Long return to user code + 94 + 95 002C E9 0000 E ERR_RG: JMP $ERR_RG + 96 + 97 + 98 ;*** $OGSA and $OGTA - ON-GOSUB and ON-GOTO + 99 ; + 100 ; Inputs: + 101 ; BX = Index + 102 ; Return address on top of stack points to table: + 103 ; DB + 104 ; DW + 105 ; DW + 106 ; . . . + 107 ; DW + 108 ; Function: + + +GOSUB - GOSUB, RETURN, and computed GOSUB/GOTO Macro-86 %1(12) 1:2:59 13-Nov-81 Page 1-3 + + + + 109 ; If index is negative or > 255, give argument error. If index is in + 110 ; range 1..N, jump to corresponding location. If index is not in this + 111 ; range, continue with next statement. If this is a GOSUB, then error + 112 ; checking (as in $GOSA, above) will be performed, along with pushing + 113 ; the return address. + 114 ; Ouputs: + 115 ; None. + 116 ; Registers: + 117 ; All except BP destroyed. + 118 + 119 002F $OGTA: + 120 002F B8 DB 0B8H ;MOV AX,(XOR AH,AH) - Insures AH non-zero + 121 0030 $OGSA: + 122 0030 32 E4 XOR AH,AH ;Set flag for gosub + 123 0032 0A FF OR BH,BH + 124 0034 75 28 JNZ ARGERR ;In range 0-255? + 125 0036 5E POP SI + 126 0037 1F POP DS ;DS:SI points to table + 127 ASSUME DS:NOTHING + 128 0038 AC LODSB ;Get upper limit of index + 129 0039 8A D0 MOV DL,AL + 130 003B B6 00 MOV DH,0 + 131 003D D1 E2 SHL DX,1 + 132 003F 03 D6 ADD DX,SI ;Compute first address after table + 133 0041 4B DEC BX ;Index should be 0 to N-1 + 134 0042 3A C3 CMP AL,BL + 135 0044 76 13 JNA ELSE1 ;If not in range, continue with next statement + 136 0046 0A E4 OR AH,AH ;Test flag + 137 0048 75 0B JNZ GETTARG ;If GOTO, skip some work + 138 004A 52 PUSH DX ;Push return address + 139 004B 26: 89 26 0000 E MOV [$$STKP],SP ;Save clean stack value + 140 0050 26: FF 06 0000 R INC [$$GCNT] ;Bump nesting level + 141 0055 GETTARG: + 142 0055 D1 E3 SHL BX,1 + 143 0057 8B 10 MOV DX,[BX+SI] ;Get target address in user segment + 144 0059 ELSE1: + 145 0059 1E PUSH DS ;Push user segment first + 146 005A 52 PUSH DX + 147 005B 06 PUSH ES + 148 005C 1F POP DS ;Restore data segment + 149 ASSUME DS:DC + 150 005D CB RET ;Long return to target code + 151 + 152 005E E9 0000 E ARGERR: JMP $ERR_FC ;Illegal Function Call if out of range + 153 + 154 0061 GOSUB ENDP + 155 0061 CODE ENDS + 156 END + + + + + + + + +GOSUB - GOSUB, RETURN, and computed GOSUB/GOTO Macro-86 %1(12) 1:2:59 13-Nov-81 Symbols-1 + + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0061 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0002 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 005E CODE +ELSE1. . . . . . . . . . . . . . L NEAR 0059 CODE +ERR_RG . . . . . . . . . . . . . L NEAR 002C CODE +GETTARG. . . . . . . . . . . . . L NEAR 0055 CODE +GOSUB. . . . . . . . . . . . . . F PROC 0000 CODE Length =0061 +RETA1. . . . . . . . . . . . . . L NEAR 0025 CODE +$$GCNT . . . . . . . . . . . . . L WORD 0000 DATA +$$STKP . . . . . . . . . . . . . V WORD 0000 DATA External +$ERR_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$ERR_RG. . . . . . . . . . . . . L NEAR 0000 CODE External +$GOSA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$OGSA. . . . . . . . . . . . . . L NEAR 0030 CODE Global +$OGTA. . . . . . . . . . . . . . L NEAR 002F CODE Global +$RELA. . . . . . . . . . . . . . L NEAR 0011 CODE Global +$RETA. . . . . . . . . . . . . . L NEAR 001C CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/GOSUB.ASM b/3_source_code/BASLIB-86/GOSUB.ASM new file mode 100644 index 0000000..99e54e2 --- /dev/null +++ b/3_source_code/BASLIB-86/GOSUB.ASM @@ -0,0 +1,156 @@ + TITLE GOSUB - GOSUB, RETURN, and computed GOSUB/GOTO + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$STKP:WORD + +$$GCNT DW ? + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $OGSA, $OGTA, $GOSA, $RELA, $RETA + + EXTRN $ERR_FC:NEAR, $ERR_RG:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +GOSUB PROC FAR ;Set up long returns + + +;*** $GOSA - GOSUB with error checking +; +; Inputs: +; Return address on top of stack points to address of target location +; Function: +; Execute a near (relative user code) call to the target, saving +; a clean stack pointer value (for after the call) and bumping the +; nesting counter for "RETURN without GOSUB" detection. +; Outputs: +; None. +; Registers: +; Destroys all except BP. + +$GOSA: + POP SI + MOV [$$STKP],SP ;Save clean stack value + POP DS ;DS:SI point to target + LODSW + PUSH SI ;Push return address + PUSH DS + PUSH AX ;DS:AX is target, now on top of stack + PUSH ES + POP DS ;Restore DS + INC [$$GCNT] ;Bump nesting level + RET ;Long return to target + + +;*** $RELA - RETURN line number address popper +; +; Inputs: +; None. +; Function: +; Pop one entry off the stack and update GOSUB level +; Outputs: +; None. +; Registers: +; Destroys all except BP. + +$RELA: + DEC [$$GCNT] ;Decrement count - error if < 0 + JS ERR_RG ;RETURN without GOSUB error? + POP BX ;IP for our return + POP AX ;CS of user code + POP CX ;Toss this address + JMP short reta1 + + +;*** $RETA - RETURN from GOSUB with error checking +; +; Inputs: +; None. +; Function: +; Execute near (relative user code) return, checking nesting level to +; avoid RETURN without GOSUB, and saving post-return clean stack value. +; Outputs: +; None. +; Registers: +; Destroys all except BP. + +$RETA: + DEC [$$GCNT] ;Decrement count - error if < 0 + JS ERR_RG ;RETURN without GOSUB error? + POP AX ;Dump IP for our return + POP AX ;CS of user code + POP BX ;This is the local return address + +reta1: MOV [$$STKP],SP ;Save clean stack level + PUSH AX ;Push CS first + PUSH BX + RET ;Long return to user code + +ERR_RG: JMP $ERR_RG + + +;*** $OGSA and $OGTA - ON-GOSUB and ON-GOTO +; +; Inputs: +; BX = Index +; Return address on top of stack points to table: +; DB +; DW +; DW +; . . . +; DW +; Function: +; If index is negative or > 255, give argument error. If index is in +; range 1..N, jump to corresponding location. If index is not in this +; range, continue with next statement. If this is a GOSUB, then error +; checking (as in $GOSA, above) will be performed, along with pushing +; the return address. +; Ouputs: +; None. +; Registers: +; All except BP destroyed. + +$OGTA: + DB 0B8H ;MOV AX,(XOR AH,AH) - Insures AH non-zero +$OGSA: + XOR AH,AH ;Set flag for gosub + OR BH,BH + JNZ ARGERR ;In range 0-255? + POP SI + POP DS ;DS:SI points to table + ASSUME DS:NOTHING + LODSB ;Get upper limit of index + MOV DL,AL + MOV DH,0 + SHL DX,1 + ADD DX,SI ;Compute first address after table + DEC BX ;Index should be 0 to N-1 + CMP AL,BL + JNA ELSE1 ;If not in range, continue with next statement + OR AH,AH ;Test flag + JNZ GETTARG ;If GOTO, skip some work + PUSH DX ;Push return address + MOV [$$STKP],SP ;Save clean stack value + INC [$$GCNT] ;Bump nesting level +GETTARG: + SHL BX,1 + MOV DX,[BX+SI] ;Get target address in user segment +ELSE1: + PUSH DS ;Push user segment first + PUSH DX + PUSH ES + POP DS ;Restore data segment + ASSUME DS:DC + RET ;Long return to target code + +ARGERR: JMP $ERR_FC ;Illegal Function Call if out of range + +GOSUB ENDP +CODE ENDS + END From 8ff2a5d2e359a0cc20ada4bab2eb9050e6727d84 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 4 Jul 2026 10:11:21 -0700 Subject: [PATCH 26/53] Transcription of Bundle 9 - HEXOCT.ASM Code and Listing --- 2_printed_files/bundle_09/HEXOCT.ASM | 181 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/HEXOCT.ASM | 97 ++++++++++++++ 2 files changed, 278 insertions(+) create mode 100644 2_printed_files/bundle_09/HEXOCT.ASM create mode 100644 3_source_code/BASLIB-86/HEXOCT.ASM diff --git a/2_printed_files/bundle_09/HEXOCT.ASM b/2_printed_files/bundle_09/HEXOCT.ASM new file mode 100644 index 0000000..b0b29eb --- /dev/null +++ b/2_printed_files/bundle_09/HEXOCT.ASM @@ -0,0 +1,181 @@ +HEXOCT - OCT, HEX functions Macro-86 %1(12) 1:3:4 13-Nov-81 Page 1-1 + + + + 1 TITLE HEXOCT - OCT, HEX functions + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $$SPSV:WORD + 6 + 7 0000 06 [ DBUF DB 6 DUP(?) + 8 ?? + 9 ] + 10 + 11 + 12 0006 DATA ENDS + 13 + 14 DC GROUP DATA + 15 + 16 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 17 + 18 PUBLIC $HEX,$OCT,$HXF,$OCF + 19 + 20 EXTRN $$CTS:NEAR,$ADC:FAR + 21 + 22 ASSUME CS:CODE, DS:DC, ES:DC + 23 + 24 0000 OCTHEX PROC FAR ;Set up for long returns + 25 + 26 + 27 ;*** $HEX,$HXF,$OCT,$OCF - Convert number to hexadecimal or octal string + 28 ; + 29 ; Inputs: + 30 ; BX - Integer value to be converted ($OCT/$HEX) + 31 ; BX - Address of SP number ($OCF/$HXF) + 32 ; Function: + 33 ; Create a string of minimum length (no leading zeros) that represents + 34 ; the value of the number in octal or hex. + 35 ; Outputs: + 36 ; BX = Address of string descriptor + 37 ; Registers: + 38 ; Only BX and F affected. + 39 + 40 0000 $OCF: + 41 0000 89 26 0000 E MOV [$$SPSV],SP + 42 0004 56 PUSH SI + 43 0005 8B F3 MOV SI,BX ;$ADC needs address in SI + 44 0007 9A 0000 ---- E CALL $ADC ;Convert SP to address + 45 000C 5E POP SI + 46 000D $OCT: + 47 000D 89 26 0000 E MOV [$$SPSV],SP + 48 0011 51 PUSH CX + 49 0012 B9 0703 MOV CX,0703H ;Shift count in CL, mask in CH + 50 0015 EB 15 JMP SHORT HEXOCT + 51 + 52 0017 $HXF: + 53 0017 89 26 0000 E MOV [$$SPSV],SP + 54 001B 56 PUSH SI + + +HEXOCT - OCT, HEX functions Macro-86 %1(12) 1:3:4 13-Nov-81 Page 1-2 + + + + 55 001C 8B F3 MOV SI,BX ;$ADC needs address in SI + 56 001E 9A 0000 ---- E CALL $ADC ;Convert SP to address + 57 0023 5E POP SI + 58 0024 $HEX: + 59 0024 89 26 0000 E MOV [$$SPSV],SP + 60 0028 51 PUSH CX + 61 0029 B9 0F04 MOV CX,0F04H ;Set mask (CH) and shift count (CL) + 62 002C HEXOCT: + 63 002C 50 PUSH AX + 64 002D 57 PUSH DI + 65 002E B4 00 MOV AH,0 ;Initialize digit count + 66 0030 BF 0005 R MOV DI,OFFSET DC:DBUF+5 ;Start from back end of digit buffer + 67 0033 FD STD ; and work down + 68 + 69 ; At this point, the following conditions exist: + 70 ; AH = character count + 71 ; CX = Shift count and mask + 72 ; BX = Number to convert + 73 ; DI = Pointer into digit buffer + 74 + 75 0034 CONV: + 76 0034 8A C3 MOV AL,BL ;Bring it to accumulator + 77 0036 22 C5 AND AL,CH ;Mask down to the bits that count + 78 ;Trick 6-byte hex conversion + 79 0038 04 90 ADD AL,90H + 80 003A 27 DAA + 81 003B 14 40 ADC AL,40H + 82 003D 27 DAA ;Number in hex now + 83 003E AA STOSB ;Save in string + 84 003F FE C4 INC AH ;Count the digits + 85 0041 D3 EB SHR BX,CL ;Bring down next digit + 86 0043 75 EF JNZ CONV + 87 0045 FC CLD ;Restore direction UP + 88 0046 47 INC DI ;Point to most significant digit + 89 0047 8A DC MOV BL,AH ;Digit count in BX (BH already zero) + 90 0049 87 FA XCHG DI,DX ;Save DX and put pointer there + 91 004B E8 0000 E CALL $$CTS ;Allocate string and copy data in + 92 004E 8B D7 MOV DX,DI ;Restore DX + 93 0050 5F POP DI + 94 0051 58 POP AX + 95 0052 59 POP CX + 96 0053 CB RET + 97 + 98 0054 OCTHEX ENDP + 99 0054 CODE ENDS + 100 END + + + + + + + + + + +HEXOCT - OCT, HEX functions Macro-86 %1(12) 1:3:4 13-Nov-81 Symbols-1 + + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0054 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0006 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +CONV . . . . . . . . . . . . . . L NEAR 0034 CODE +DBUF . . . . . . . . . . . . . . L BYTE 0000 DATA Length =0006 +HEXOCT . . . . . . . . . . . . . L NEAR 002C CODE +OCTHEX . . . . . . . . . . . . . F PROC 0000 CODE Length =0054 +$$CTS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$ADC . . . . . . . . . . . . . . L FAR 0000 CODE External +$HEX . . . . . . . . . . . . . . L NEAR 0024 CODE Global +$HXF . . . . . . . . . . . . . . L NEAR 0017 CODE Global +$OCF . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$OCT . . . . . . . . . . . . . . L NEAR 000D CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/HEXOCT.ASM b/3_source_code/BASLIB-86/HEXOCT.ASM new file mode 100644 index 0000000..c1e53dc --- /dev/null +++ b/3_source_code/BASLIB-86/HEXOCT.ASM @@ -0,0 +1,97 @@ + TITLE HEXOCT - OCT, HEX functions + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$SPSV:WORD + +DBUF DB 6 DUP(?) + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $HEX,$OCT,$HXF,$OCF + + EXTRN $$CTS:NEAR,$ADC:FAR + + ASSUME CS:CODE, DS:DC, ES:DC + +OCTHEX PROC FAR ;Set up for long returns + + +;*** $HEX,$HXF,$OCT,$OCF - Convert number to hexadecimal or octal string +; +; Inputs: +; BX - Integer value to be converted ($OCT/$HEX) +; BX - Address of SP number ($OCF/$HXF) +; Function: +; Create a string of minimum length (no leading zeros) that represents +; the value of the number in octal or hex. +; Outputs: +; BX = Address of string descriptor +; Registers: +; Only BX and F affected. + +$OCF: + MOV [$$SPSV],SP + PUSH SI + MOV SI,BX ;$ADC needs address in SI + CALL $ADC ;Convert SP to address + POP SI +$OCT: + MOV [$$SPSV],SP + PUSH CX + MOV CX,0703H ;Shift count in CL, mask in CH + JMP SHORT HEXOCT + +$HXF: + MOV [$$SPSV],SP + PUSH SI + MOV SI,BX ;$ADC needs address in SI + CALL $ADC ;Convert SP to address + POP SI +$HEX: + MOV [$$SPSV],SP + PUSH CX + MOV CX,0F04H ;Set mask (CH) and shift count (CL) +HEXOCT: + PUSH AX + PUSH DI + MOV AH,0 ;Initialize digit count + MOV DI,OFFSET DC:DBUF+5 ;Start from back end of digit buffer + STD ; and work down + +; At this point, the following conditions exist: +; AH = character count +; CX = Shift count and mask +; BX = Number to convert +; DI = Pointer into digit buffer + +CONV: + MOV AL,BL ;Bring it to accumulator + AND AL,CH ;Mask down to the bits that count +;Trick 6-byte hex conversion + ADD AL,90H + DAA + ADC AL,40H + DAA ;Number in hex now + STOSB ;Save in string + INC AH ;Count the digits + SHR BX,CL ;Bring down next digit + JNZ CONV + CLD ;Restore direction UP + INC DI ;Point to most significant digit + MOV BL,AH ;Digit count in BX (BH already zero) + XCHG DI,DX ;Save DX and put pointer there + CALL $$CTS ;Allocate string and copy data in + MOV DX,DI ;Restore DX + POP DI + POP AX + POP CX + RET + +OCTHEX ENDP +CODE ENDS + END From d1fd8a06c428241733f0a3ef16ab4cba9168c15c Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 4 Jul 2026 11:12:42 -0700 Subject: [PATCH 27/53] Transcription of Bundle 9 - INPDSK.ASM Code and Listing NOTE there are several extra records in the symbol table that are not in the source code for the listing. This results in "Symbol not defined" error at line 43. This is due to assembler directives to mask the includes. I've found them later in the bundle and will create appropriate include files as I encounter them. --- 2_printed_files/bundle_09/INPDSK.ASM | 421 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/INPDSK.ASM | 138 +++++++++ 2 files changed, 559 insertions(+) create mode 100644 2_printed_files/bundle_09/INPDSK.ASM create mode 100644 3_source_code/BASLIB-86/INPDSK.ASM diff --git a/2_printed_files/bundle_09/INPDSK.ASM b/2_printed_files/bundle_09/INPDSK.ASM new file mode 100644 index 0000000..f08855e --- /dev/null +++ b/2_printed_files/bundle_09/INPDSK.ASM @@ -0,0 +1,421 @@ +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Page 1-1 + + + + 1 TITLE INPDSK - Handle input from disk + 2 + 3 = 000D CR= 13 + 4 = 000A LF= 10 + 5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Page 1-2 + + + + 6 .LIST + 7 + 8 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 9 + 10 EXTRN $FILBUF:WORD,$PTRFIL:WORD,$$SPSV:WORD,$INBUF:BYTE + 11 + 12 0000 DATA ENDS + 13 + 14 + 15 DC GROUP DATA + 16 + 17 + 18 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 19 + 20 PUBLIC $IN0B + 21 + 22 EXTRN $FBLOC:NEAR,$GETCHR:NEAR,$BAKCHR:NEAR + 23 EXTRN $ERC_BFM:NEAR,$ERC_IFN:NEAR,$ERC_RPE:NEAR + 24 + 25 ASSUME CS:CODE, DS:DC, ES:DC + 26 + 27 + 28 ;*** $IN0B - Prepare for disk input + 29 ; + 30 ; Inputs: + 31 ; BX = File number + 32 ; Function: + 33 ; Set up parameters so input will come from disk + 34 ; Outputs: + 35 ; None. + 36 ; Registers: + 37 ; All but BP destroyed. + 38 + 39 0000 $IN0B PROC FAR + 40 0000 89 26 0000 E MOV [$$SPSV],SP + 41 0004 E8 0000 E CALL $FBLOC + 42 0007 74 10 JZ ARGERR + 43 0009 80 3C 02 CMP [SI].FD_MODE,MD_SQO + 44 000C 74 0E JE BADMODE + 45 000E 89 36 0000 E MOV [$PTRFIL],SI + 46 0012 C7 06 0000 E 0022 R MOV [$FILBUF],OFFSET FILBUF + 47 0018 CB RET + 48 0019 $IN0B ENDP + 49 + 50 0019 E9 0000 E ARGERR: JMP $ERC_IFN ;Illegal file number + 51 001C E9 0000 E BADMODE:JMP $ERC_BFM ;Bad file mode + 52 001F E9 0000 E EOFERR: JMP $ERC_RPE + 53 + 54 0022 FILBUF: + 55 0022 E8 0000 E CALL $GETCHR + 56 0025 72 F8 JC EOFERR + 57 0027 0A D2 OR DL,DL ;Line input? + 58 0029 74 04 JZ NOSPC + 59 002B 3C 20 CMP AL," " + + +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Page 1-3 + + + + 60 002D 74 F3 JZ FILBUF + 61 002F NOSPC: + 62 002F BF 0000 E MOV DI,OFFSET DC:$INBUF + 63 0032 3C 22 CMP AL,'"' ;Quoted string? + 64 0034 75 0D JNZ NOTQUOTE + 65 0036 80 FA 2C CMP DL,"," ;Looking for a string? + 66 0039 75 08 JNZ NOTQUOTE + 67 003B BA 2222 MOV DX,'""' ;Set delimiters to '"' + 68 003E E8 0000 E CALL $GETCHR + 69 0041 72 3A JC QUIT ;Null string? + 70 0043 NOTQUOTE: + 71 0043 B1 FF MOV CL,255 ;Allow 255 characters + 72 0045 LOPCRS: + 73 0045 80 FE 22 CMP DH,'"' ;Getting a quoted string? + 74 0048 74 1F JZ SKPCHK + 75 004A 3C 0D CMP AL,CR ;End of line? + 76 004C 74 48 JZ ENDCR + 77 004E 3C 0A CMP AL,LF + 78 0050 75 17 JNZ SKPCHK + 79 ;Have a linefeed and this is not a quoted string + 80 0052 80 FA 2C CMP DL,"," ;Getting an unquoted string? + 81 0055 74 03 JZ NOSTO ;Don't store linefeeds in unquoted strings + 82 0057 E8 00A9 R CALL STRCHR + 83 005A NOSTO: + 84 005A E8 0000 E CALL $GETCHR + 85 005D 3C 0D CMP AL,CR ;Ignore CR after LF + 86 005F 75 08 JNZ SKPCHK + 87 0061 80 FA 20 CMP DL," " ;Looking for number? + 88 0064 74 12 JZ NEXCHR + 89 0066 80 FA 2C CMP DL,"," ;Looking for unquoted string? + 90 0069 SKPCHK: + 91 0069 0A C0 OR AL,AL + 92 006B 74 0B JZ NEXCHR ;Ignore nulls + 93 006D 3A C6 CMP AL,DH ;Check for first terminator + 94 006F 74 0C JZ QUIT + 95 0071 3A C2 CMP AL,DL ;Check for second terminator + 96 0073 74 08 JZ QUIT + 97 0075 E8 00A9 R CALL STRCHR ;Store the character + 98 0078 NEXCHR: + 99 0078 E8 0000 E CALL $GETCHR + 100 007B 73 C8 JNC LOPCRS + 101 007D QUIT: + 102 007D 3C 22 CMP AL,'"' ;Finishing a quoted string? + 103 007F 74 04 JZ MORSPC + 104 0081 3C 20 CMP AL," " + 105 0083 75 1D JNZ PUTZER + 106 0085 MORSPC: + 107 0085 E8 0000 E CALL $GETCHR + 108 0088 72 18 JC PUTZER + 109 008A 3C 20 CMP AL," " + 110 008C 74 F7 JZ MORSPC + 111 008E 3C 2C CMP AL,"," ;Eat comma separator + 112 0090 74 10 JZ PUTZER + 113 0092 3C 0D CMP AL,CR + + +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Page 1-4 + + + + 114 0094 75 09 JNZ BACKUP + 115 0096 ENDCR: + 116 0096 E8 0000 E CALL $GETCHR + 117 0099 72 07 JC PUTZER + 118 009B 3C 0A CMP AL,LF + 119 009D 74 03 JZ PUTZER + 120 009F BACKUP: + 121 009F E8 0000 E CALL $BAKCHR + 122 00A2 PUTZER: + 123 00A2 32 C0 XOR AL,AL + 124 00A4 AA STOSB + 125 00A5 BE 0000 E MOV SI,OFFSET DC:$INBUF + 126 00A8 C3 RET: RET + 127 + 128 00A9 STRCHR: + 129 00A9 0A C0 OR AL,AL + 130 00AB 74 FB JZ RET + 131 00AD AA STOSB + 132 00AE FE C9 DEC CL ;Buffer full? + 133 00B0 75 F6 JNZ RET + 134 00B2 59 POP CX ;Dump a return address + 135 00B3 EB ED JMP PUTZER ;Quit if buffer full + 136 + 137 00B5 CODE ENDS + 138 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00B5 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 0019 CODE +BACKUP . . . . . . . . . . . . . L NEAR 009F CODE +BADMODE. . . . . . . . . . . . . L NEAR 001C CODE +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +CR . . . . . . . . . . . . . . . Number 000D +DN_KYBD. . . . . . . . . . . . . Number FFFF + + +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Symbols-2 + + + +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_Width . . . . . . . . . . . . Number 0008 +ENDCR. . . . . . . . . . . . . . L NEAR 0096 CODE +EOFCHR . . . . . . . . . . . . . Number 001A +EOFERR . . . . . . . . . . . . . L NEAR 001F CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILBUF . . . . . . . . . . . . . L NEAR 0022 CODE +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LF . . . . . . . . . . . . . . . Number 000A +LOPCRS . . . . . . . . . . . . . L NEAR 0045 CODE +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +MORSPC . . . . . . . . . . . . . L NEAR 0085 CODE +NEXCHR . . . . . . . . . . . . . L NEAR 0078 CODE +NOSPC. . . . . . . . . . . . . . L NEAR 002F CODE +NOSTO. . . . . . . . . . . . . . L NEAR 005A CODE +NOTQUOTE . . . . . . . . . . . . L NEAR 0043 CODE +PUTZER . . . . . . . . . . . . . L NEAR 00A2 CODE +QUIT . . . . . . . . . . . . . . L NEAR 007D CODE +REC_LENGTH . . . . . . . . . . . Number 0080 +RET. . . . . . . . . . . . . . . L NEAR 00A8 CODE +SKPCHK . . . . . . . . . . . . . L NEAR 0069 CODE +STRCHR . . . . . . . . . . . . . L NEAR 00A9 CODE +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$BAKCHR. . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IFN . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_RPE . . . . . . . . . . . . L NEAR 0000 CODE External +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE External +$FILBUF. . . . . . . . . . . . . V WORD 0000 DATA External +$GETCHR. . . . . . . . . . . . . L NEAR 0000 CODE External + + +INPDSK - Handle input from disk Macro-86 %1(12) 1:3:9 13-Nov-81 Symbols-3 + + + +$IN0B. . . . . . . . . . . . . . F PROC 0000 CODE Global Length =0019 +$INBUF . . . . . . . . . . . . . V BYTE 0000 DATA External +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/INPDSK.ASM b/3_source_code/BASLIB-86/INPDSK.ASM new file mode 100644 index 0000000..81a6add --- /dev/null +++ b/3_source_code/BASLIB-86/INPDSK.ASM @@ -0,0 +1,138 @@ + TITLE INPDSK - Handle input from disk + +CR= 13 +LF= 10 + + .LIST + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FILBUF:WORD,$PTRFIL:WORD,$$SPSV:WORD,$INBUF:BYTE + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $IN0B + + EXTRN $FBLOC:NEAR,$GETCHR:NEAR,$BAKCHR:NEAR + EXTRN $ERC_BFM:NEAR,$ERC_IFN:NEAR,$ERC_RPE:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $IN0B - Prepare for disk input +; +; Inputs: +; BX = File number +; Function: +; Set up parameters so input will come from disk +; Outputs: +; None. +; Registers: +; All but BP destroyed. + +$IN0B PROC FAR + MOV [$$SPSV],SP + CALL $FBLOC + JZ ARGERR + CMP [SI].FD_MODE,MD_SQO + JE BADMODE + MOV [$PTRFIL],SI + MOV [$FILBUF],OFFSET FILBUF + RET +$IN0B ENDP + +ARGERR: JMP $ERC_IFN ;Illegal file number +BADMODE:JMP $ERC_BFM ;Bad file mode +EOFERR: JMP $ERC_RPE + +FILBUF: + CALL $GETCHR + JC EOFERR + OR DL,DL ;Line input? + JZ NOSPC + CMP AL," " + JZ FILBUF +NOSPC: + MOV DI,OFFSET DC:$INBUF + CMP AL,'"' ;Quoted string? + JNZ NOTQUOTE + CMP DL,"," ;Looking for a string? + JNZ NOTQUOTE + MOV DX,'""' ;Set delimiters to '"' + CALL $GETCHR + JC QUIT ;Null string? +NOTQUOTE: + MOV CL,255 ;Allow 255 characters +LOPCRS: + CMP DH,'"' ;Getting a quoted string? + JZ SKPCHK + CMP AL,CR ;End of line? + JZ ENDCR + CMP AL,LF + JNZ SKPCHK +;Have a linefeed and this is not a quoted string + CMP DL,"," ;Getting an unquoted string? + JZ NOSTO ;Don't store linefeeds in unquoted strings + CALL STRCHR +NOSTO: + CALL $GETCHR + CMP AL,CR ;Ignore CR after LF + JNZ SKPCHK + CMP DL," " ;Looking for number? + JZ NEXCHR + CMP DL,"," ;Looking for unquoted string? +SKPCHK: + OR AL,AL + JZ NEXCHR ;Ignore nulls + CMP AL,DH ;Check for first terminator + JZ QUIT + CMP AL,DL ;Check for second terminator + JZ QUIT + CALL STRCHR ;Store the character +NEXCHR: + CALL $GETCHR + JNC LOPCRS +QUIT: + CMP AL,'"' ;Finishing a quoted string? + JZ MORSPC + CMP AL," " + JNZ PUTZER +MORSPC: + CALL $GETCHR + JC PUTZER + CMP AL," " + JZ MORSPC + CMP AL,"," ;Eat comma separator + JZ PUTZER + CMP AL,CR + JNZ BACKUP +ENDCR: + CALL $GETCHR + JC PUTZER + CMP AL,LF + JZ PUTZER +BACKUP: + CALL $BAKCHR +PUTZER: + XOR AL,AL + STOSB + MOV SI,OFFSET DC:$INBUF +RET: RET + +STRCHR: + OR AL,AL + JZ RET + STOSB + DEC CL ;Buffer full? + JNZ RET + POP CX ;Dump a return address + JMP PUTZER ;Quit if buffer full + +CODE ENDS + END From 8569a6c237b3c6364bec7e708af335c67914e44a Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sat, 4 Jul 2026 11:37:18 -0700 Subject: [PATCH 28/53] Transcription of Bundle 9 - INPTTY.ASM Code and Listing --- 2_printed_files/bundle_09/INPTTY.ASM | 180 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/INPTTY.ASM | 78 ++++++++++++ 2 files changed, 258 insertions(+) create mode 100644 2_printed_files/bundle_09/INPTTY.ASM create mode 100644 3_source_code/BASLIB-86/INPTTY.ASM diff --git a/2_printed_files/bundle_09/INPTTY.ASM b/2_printed_files/bundle_09/INPTTY.ASM new file mode 100644 index 0000000..621e315 --- /dev/null +++ b/2_printed_files/bundle_09/INPTTY.ASM @@ -0,0 +1,180 @@ +INPTTY - Prepare for input from TTY Macro-86 %1(12) 1:3:21 13-Nov-81 Page 1-1 + + + + 1 TITLE INPTTY - Prepare for input from TTY + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $PTRFIL:WORD,$$ERRV:WORD,$INBUF:BYTE,$BUFLEN:BYTE,$LINELEN:BYTE + 6 EXTRN $FILBUF:WORD + 7 + 8 0000 ???? PROMPT DW ? + 9 0002 ?? INFL DB ? + 10 + 11 0003 DATA ENDS + 12 + 13 DC GROUP DATA + 14 + 15 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 16 + 17 PUBLIC $IN0A,$REDO + 18 + 19 EXTRN $TYPSTR:NEAR,$$WCH:NEAR,$$WCLF:NEAR,$INPOVF:NEAR + 20 EXTRN $RDLIN:NEAR + 21 + 22 ASSUME CS:CODE, DS:DC, ES:DC + 23 + 24 + 25 0000 INPUT PROC FAR + 26 + 27 ;*** $IN0A - Prepare for console input + 28 ; + 29 ; Inputs: + 30 ; BX = Address of prompt string descriptor. + 31 ; Return address on top of stack has long pointer to parameter byte. + 32 ; If bit 1 is set in this byte, don't print "?" after prompt. + 33 ; If bit 0 is set, don't echo CR/LF after getting input. + 34 ; Function: + 35 ; Set up input from TTY and read input line. + 36 ; Outputs: + 37 ; None. + 38 ; Registers: + 39 ; All except BP destroyed. + 40 + 41 0000 $IN0A: + 42 0000 5E POP SI + 43 0001 1F POP DS ;Point to parameter byte + 44 0002 AC LODSB + 45 0003 1E PUSH DS + 46 0004 56 PUSH SI ;Put return address back on stack + 47 0005 06 PUSH ES + 48 0006 1F POP DS ;Restore DS + 49 0007 A2 0002 R MOV [INFL],AL ;Save parameter byte + 50 000A 89 1E 0000 R MOV [PROMPT],BX ;Save prompt string descriptor address + 51 000E C7 06 0000 E 0000 MOV [$PTRFIL],0 ;Set output to terminal + 52 0014 C7 06 0000 E 0000 E MOV [$$ERRV],OFFSET $INPOVF ;Trap all errors + 53 001A C7 06 0000 E 0046 R MOV [$FILBUF],OFFSET RET ;Don't get input from disk + 54 0020 $REDO: + + +INPTTY - Prepare for input from TTY Macro-86 %1(12) 1:3:21 13-Nov-81 Page 1-2 + + + + 55 ;Enter here if error to re-prompt and re-read data + 56 0020 8B 1E 0000 R MOV BX,[PROMPT] + 57 0024 E8 0000 E CALL $TYPSTR ;Print string + 58 0027 F6 06 0002 R 02 TEST [INFL],2 ;Need a "?" after prompt? + 59 002C 75 0A JNZ GETLIN + 60 002E B0 3F MOV AL,"?" + 61 0030 E8 0000 E CALL $$WCH + 62 0033 B0 20 MOV AL," " + 63 0035 E8 0000 E CALL $$WCH + 64 0038 GETLIN: + 65 0038 E8 0000 E CALL $RDLIN ;Get input line + 66 003B F6 06 0002 R 01 TEST [INFL],1 ;Is it INPUT "semi-colon" ? + 67 0040 75 03 JNZ GETLIX ;Yes, don't send + 68 0042 E8 0000 E CALL $$WCLF + 69 0045 GETLIX: + 70 0045 CB RET + 71 + 72 0046 INPUT ENDP + 73 + 74 + 75 0046 C3 RET: RET ;NEAR RET + 76 + 77 0047 CODE ENDS + 78 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INPTTY - Prepare for input from TTY Macro-86 %1(12) 1:3:21 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0047 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0003 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +GETLIN . . . . . . . . . . . . . L NEAR 0038 CODE +GETLIX . . . . . . . . . . . . . L NEAR 0045 CODE +INFL . . . . . . . . . . . . . . L BYTE 0002 DATA +INPUT. . . . . . . . . . . . . . F PROC 0000 CODE Length =0046 +PROMPT . . . . . . . . . . . . . L WORD 0000 DATA +RET. . . . . . . . . . . . . . . L NEAR 0046 CODE +$$ERRV . . . . . . . . . . . . . V WORD 0000 DATA External +$$WCH. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WCLF . . . . . . . . . . . . . L NEAR 0000 CODE External +$BUFLEN. . . . . . . . . . . . . V BYTE 0000 DATA External +$FILBUF. . . . . . . . . . . . . V WORD 0000 DATA External +$IN0A. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$INBUF . . . . . . . . . . . . . V BYTE 0000 DATA External +$INPOVF. . . . . . . . . . . . . L NEAR 0000 CODE External +$LINELEN . . . . . . . . . . . . V BYTE 0000 DATA External +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +$RDLIN . . . . . . . . . . . . . L NEAR 0000 CODE External +$REDO. . . . . . . . . . . . . . L NEAR 0020 CODE Global +$TYPSTR. . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/INPTTY.ASM b/3_source_code/BASLIB-86/INPTTY.ASM new file mode 100644 index 0000000..d189a52 --- /dev/null +++ b/3_source_code/BASLIB-86/INPTTY.ASM @@ -0,0 +1,78 @@ + TITLE INPTTY - Prepare for input from TTY + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $PTRFIL:WORD,$$ERRV:WORD,$INBUF:BYTE,$BUFLEN:BYTE,$LINELEN:BYTE + EXTRN $FILBUF:WORD + +PROMPT DW ? +INFL DB ? + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $IN0A,$REDO + + EXTRN $TYPSTR:NEAR,$$WCH:NEAR,$$WCLF:NEAR,$INPOVF:NEAR + EXTRN $RDLIN:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +INPUT PROC FAR + +;*** $IN0A - Prepare for console input +; +; Inputs: +; BX = Address of prompt string descriptor. +; Return address on top of stack has long pointer to parameter byte. +; If bit 1 is set in this byte, don't print "?" after prompt. +; If bit 0 is set, don't echo CR/LF after getting input. +; Function: +; Set up input from TTY and read input line. +; Outputs: +; None. +; Registers: +; All except BP destroyed. + +$IN0A: + POP SI + POP DS ;Point to parameter byte + LODSB + PUSH DS + PUSH SI ;Put return address back on stack + PUSH ES + POP DS ;Restore DS + MOV [INFL],AL ;Save parameter byte + MOV [PROMPT],BX ;Save prompt string descriptor address + MOV [$PTRFIL],0 ;Set output to terminal + MOV [$$ERRV],OFFSET $INPOVF ;Trap all errors + MOV [$FILBUF],OFFSET RET ;Don't get input from disk +$REDO: +;Enter here if error to re-prompt and re-read data + MOV BX,[PROMPT] + CALL $TYPSTR ;Print string + TEST [INFL],2 ;Need a "?" after prompt? + JNZ GETLIN + MOV AL,"?" + CALL $$WCH + MOV AL," " + CALL $$WCH +GETLIN: + CALL $RDLIN ;Get input line + TEST [INFL],1 ;Is it INPUT "semi-colon" ? + JNZ GETLIX ;Yes, don't send + CALL $$WCLF +GETLIX: + RET + +INPUT ENDP + + +RET: RET ;NEAR RET + +CODE ENDS + END From 8f525d06895243e9aa90d1f337fad0b0c88658f8 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 7 Jul 2026 18:38:21 -0700 Subject: [PATCH 29/53] Transcription of Bundle 9 - INPUT.ASM Code and Listing --- 2_printed_files/bundle_09/INPUT.ASM | 420 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/INPUT.ASM | 230 +++++++++++++++ 2 files changed, 650 insertions(+) create mode 100644 2_printed_files/bundle_09/INPUT.ASM create mode 100644 3_source_code/BASLIB-86/INPUT.ASM diff --git a/2_printed_files/bundle_09/INPUT.ASM b/2_printed_files/bundle_09/INPUT.ASM new file mode 100644 index 0000000..a3c06d9 --- /dev/null +++ b/2_printed_files/bundle_09/INPUT.ASM @@ -0,0 +1,420 @@ +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Page 1-1 + + + + 1 TITLE INPUT - INPUT statement + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 PUBLIC $FILBUF,$INBUF,$BUFLEN,$LINLEN + 6 + 7 EXTRN VALTYP:BYTE,$$ERRV:WORD,$AC:WORD,$PTRFIL:WORD,$$SPSV:WORD + 8 + 9 = 0000 EOL EQU 0 + 10 + 11 0000 ???? $FILBUF DW ? + 12 0002 LONGRET LABEL DWORD + 13 0002 RETOFF LABEL WORD + 14 0002 ???? TYPLST DW ? ;Share with return addr. offset + 15 0004 ???? RETSEG DW ? + 16 0006 ???? DATAPT DW ? + 17 0008 ???? CLEAN DW ? + 18 000A ?? TYPCNT DB ? + 19 000B ?? VALCNT DB ? + 20 + 21 000C ?? $BUFLEN DB ? + 22 000D ?? $LINLEN DB ? + 23 000E 0100 [ $INBUF DB 256 DUP (?) + 24 ?? + 25 ] + 26 + 27 + 28 010E DATA ENDS + 29 + 30 + 31 0000 CONST SEGMENT BYTE PUBLIC 'CONST' + 32 + 33 0000 02 04 08 03 TYPTAB DB 2,4,8,3 + 34 + 35 0004 CONST ENDS + 36 + 37 + 38 DC GROUP DATA,CONST + 39 + 40 + 41 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 42 + 43 PUBLIC $IPUA,$IPUB,$INPOVF + 44 + 45 EXTRN $TYPTX:NEAR,$FIN:NEAR,$GETCH:NEAR,$IN0A:NEAR,$REDO:FAR + 46 EXTRN $CONT:NEAR,$$CTS:NEAR,$$TCR:NEAR,$SAS:FAR + 47 + 48 ASSUME CS:CODE, DS:DC, ES:DC + 49 + 50 0000 INPUT PROC FAR ;Set up long returns + 51 + 52 + 53 ;*** $IPUA - Get input line + 54 ; + + +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Page 1-2 + + + + 55 ; Inputs: + 56 ; Return address on top of stack is long pointer to list of values to + 57 ; input. First byte in list is number of values, following are types of + 58 ; each value. Thus the calling sequence looks like this: + 59 ; + 60 ; CALL $IPUA + 61 ; DB + 62 ; DB + 63 ; DB + 64 ; . . . + 65 ; DB + 66 ; + 67 ; + 68 ; The type of values are: + 69 ; + 70 ; 4 = Integer + 71 ; 5 = Single precision + 72 ; 6 = Double precision + 73 ; 7 = String + 74 ; + 75 ; Function: + 76 ; Prompt and read input line, and decode each value, checking to be + 77 ; sure everything is OK and types match. If anything goes wrong, print + 78 ; "?Redo from start" and start over. Values will be saved on stack, so + 79 ; user code must not have anything saved on the stack when this is + 80 ; called. Values will be read with $IPUB. + 81 ; Outputs: + 82 ; None. + 83 ; Registers: + 84 ; All except BP destroyed. + 85 + 86 0000 $IPUA: + 87 0000 5F POP DI + 88 0001 07 POP ES ;ES:DI point to list of types + 89 0002 26: 8A 05 MOV AL,ES:[DI] ;Get number of values to input + 90 0005 47 INC DI + 91 0006 8C 06 0004 R MOV [RETSEG],ES + 92 000A 89 3E 0002 R MOV [TYPLST],DI ;If we have to restart, remember start of list + 93 000E A2 000B R MOV [VALCNT],AL ;Remember number of values + 94 0011 89 26 0008 R MOV [CLEAN],SP ;Clean stack value + 95 0015 89 26 0006 R MOV [DATAPT],SP ;Read values back from here + 96 0019 REDO: + 97 0019 A2 000A R MOV [TYPCNT],AL ;Initialize count of values + 98 001C BE 000E R MOV SI,OFFSET DC:$INBUF + 99 001F EACHVAL: + 100 001F 26: 8A 05 MOV AL,ES:[DI] ;Get next type + 101 0022 47 INC DI + 102 0023 BB FFFC R MOV BX,OFFSET DC:TYPTAB-4 ;Convert type so FIN will understand + 103 0026 D7 XLAT + 104 0027 98 CBW + 105 0028 50 PUSH AX ;Put type on stack + 106 0029 A2 0000 E MOV [VALTYP],AL + 107 002C 06 PUSH ES + 108 002D 57 PUSH DI + + +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Page 1-3 + + + + 109 002E 89 26 0000 E MOV [$$SPSV],SP ;Save stack address here if error + 110 0032 1E PUSH DS + 111 0033 07 POP ES ;ES = DS + 112 0034 55 PUSH BP + 113 0035 BA 2C20 MOV DX,","*256+" " ;Set up numeric delimiters + 114 0038 3C 03 CMP AL,3 ;Is it string? + 115 003A 75 02 JNZ CALLBUF + 116 003C 8A D6 MOV DL,DH ;Make both delimiters "," + 117 003E CALLBUF: + 118 003E FF 16 0000 R CALL [$FILBUF] ;Get a buffer if disk I/O + 119 0042 E8 0000 E CALL $FIN ;Get number or string + 120 0045 5D POP BP + 121 0046 5F POP DI + 122 0047 07 POP ES + 123 0048 80 3E 0000 E 04 CMP [VALTYP],4 ;Set flags on type of value + 124 004D BB 0000 E MOV BX,OFFSET DC:$AC + 125 0050 72 03 JB PUSHAC ;Don't do high word if integer or string + 126 0052 FF 77 02 PUSH [BX+2] ;Push highest word + 127 0055 PUSHAC: + 128 0055 FF 37 PUSH [BX] + 129 0057 76 06 JBE NXTVAL ;Only push low words if D.P. + 130 0059 FF 77 FE PUSH [BX-2] + 131 005C FF 77 FC PUSH [BX-4] + 132 005F NXTVAL: + 133 005F 81 3E 0000 E 0000 E CMP [$$ERRV],OFFSET $CONT ;See if vector has been changed + 134 0065 74 36 JZ CNTDSK ;If not, we're doing disk input + 135 0067 E8 0000 E CALL $GETCH ;Skip over blanks, etc. + 136 006A FE 0E 000A R DEC [TYPCNT] ;Any values left? + 137 006E 74 38 JZ CHKEND + 138 0070 3C 2C CMP AL,"," ;Values must be separated by "," + 139 0072 74 AB JZ EACHVAL + 140 0074 INPERR: + 141 ;Come here to restart if any error occured + 142 0074 8B 26 0008 R MOV SP,[CLEAN] + 143 0078 E8 0000 E CALL $TYPTX + 144 007B 3F 52 65 64 6F 20 DB "?Redo from star","t"+80H + 145 66 72 6F 6D 20 73 + 146 74 61 72 F4 + 147 008B E8 0000 E CALL $$TCR ;Output CR/LF + 148 008E 9A 0000 ---- E CALL $REDO ;Get new input line + 149 0093 A0 000B R MOV AL,[VALCNT] ;Re-initialize + 150 0096 C4 3E 0002 R LES DI,[LONGRET] + 151 009A E9 0019 R JMP REDO + 152 + 153 + 154 009D CNTDSK: + 155 009D FE 0E 000A R DEC [TYPCNT] ;Count the values + 156 00A1 74 03 JZ donval ;Can't make it all the way + 157 00A3 E9 001F R JMP EACHVAL + 158 00A6 donval: + 159 00A6 32 C0 XOR AL,AL ;Flag that we reached the end + 160 00A8 CHKEND: + 161 00A8 0A C0 OR AL,AL ;Did we reach end of line? + 162 00AA 75 C8 JNZ INPERR + + +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Page 1-4 + + + + 163 00AC C7 06 0000 E 0000 E MOV [$$ERRV],OFFSET $CONT ;Restore error vector + 164 00B2 06 PUSH ES + 165 00B3 57 PUSH DI ;Put return address back on stack + 166 00B4 1E PUSH DS + 167 00B5 07 POP ES ;Restore ES + 168 00B6 CB RET: RET + 169 + 170 00B7 $INPOVF: + 171 ;Come here from error trap if overflow in FIN + 172 00B7 E8 0000 E CALL $TYPTX + 173 00BA 4F 76 65 72 66 6C DB "Overflo","w"+80H + 174 6F F7 + 175 00C2 E8 0000 E CALL $$TCR ;Output CR/LF + 176 00C5 EB AD JMP INPERR + 177 + 178 + 179 ;*** $IPUB - Copy input values into variables + 180 ; + 181 ; Inputs: + 182 ; BX = Address of variable + 183 ; Function: + 184 ; Recover value input for that variable from the stack and copy it in. + 185 ; When last variable has been assigned, recover stack space. + 186 ; Outputs: + 187 ; None. + 188 ; Registers: + 189 ; Only F affected. + 190 + 191 00C7 $IPUB: + 192 00C7 56 PUSH SI + 193 00C8 57 PUSH DI + 194 00C9 51 PUSH CX + 195 00CA 1E PUSH DS + 196 00CB 8B 36 0006 R MOV SI,[DATAPT] ;Get pointer to next value + 197 00CF 16 PUSH SS + 198 00D0 1F POP DS ;Values stored in stack segment + 199 00D1 4E DEC SI + 200 00D2 4E DEC SI ;Point to its type + 201 00D3 8B 0C MOV CX,[SI] ;Type also equals length if numeric + 202 00D5 8B F9 MOV DI,CX + 203 00D7 81 E7 FFFE AND DI,NOT 1 ;Clear LSB so DI = length + 204 00DB 2B F7 SUB SI,DI ;Point to its low end + 205 00DD 26: 89 36 0006 R MOV ES:[DATAPT],SI ;For next call + 206 00E2 80 F9 03 CMP CL,3 ;Type STRING? + 207 00E5 74 20 JZ ASSTRG ;Go assign string + 208 00E7 8B FB MOV DI,BX + 209 00E9 D1 E9 SHR CX,1 ;Move by words + 210 00EB F3/ A5 REP MOVSW ;Assign variable + 211 00ED 1F POP DS + 212 00EE ASSNXT: + 213 00EE 59 POP CX + 214 00EF 5F POP DI + 215 00F0 5E POP SI + 216 00F1 FE 0E 000B R DEC [VALCNT] ;Any more to go? + + +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Page 1-5 + + + + 217 00F5 75 BF JNZ RET ;If so, we'll wait for next call + 218 ;Clean up stack + 219 00F7 8F 06 0002 R POP [RETOFF] + 220 00FB 8F 06 0004 R POP [RETSEG] + 221 00FF 8B 26 0008 R MOV SP,[CLEAN] + 222 0103 FF 2E 0002 R JMP [LONGRET] + 223 + 224 0107 ASSTRG: + 225 0107 8B 34 MOV SI,[SI] ;Get pointer to string descriptor + 226 0109 1F POP DS + 227 010A 87 F2 XCHG SI,DX + 228 010C 87 D3 XCHG DX,BX ;BX has source, DX has destination + 229 010E 9A 0000 ---- E CALL $SAS ;Do string assign + 230 0113 8B DA MOV BX,DX + 231 0115 8B D6 MOV DX,SI ;Restore BX and DX + 232 0117 EB D5 JMP ASSNXT + 233 + 234 0119 INPUT ENDP + 235 0119 CODE ENDS + 236 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0119 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 010E WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 0004 BYTE PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +ASSNXT . . . . . . . . . . . . . L NEAR 00EE CODE +ASSTRG . . . . . . . . . . . . . L NEAR 0107 CODE +CALLBUF. . . . . . . . . . . . . L NEAR 003E CODE +CHKEND . . . . . . . . . . . . . L NEAR 00A8 CODE +CLEAN. . . . . . . . . . . . . . L WORD 0008 DATA +CNTDSK . . . . . . . . . . . . . L NEAR 009D CODE +DATAPT . . . . . . . . . . . . . L WORD 0006 DATA +DONVAL . . . . . . . . . . . . . L NEAR 00A6 CODE +EACHVAL. . . . . . . . . . . . . L NEAR 001F CODE +EOL. . . . . . . . . . . . . . . Number 0000 +INPERR . . . . . . . . . . . . . L NEAR 0074 CODE +INPUT. . . . . . . . . . . . . . F PROC 0000 CODE Length =0119 +LONGRET. . . . . . . . . . . . . L DWORD 0002 DATA +NXTVAL . . . . . . . . . . . . . L NEAR 005F CODE +PUSHAC . . . . . . . . . . . . . L NEAR 0055 CODE +REDO . . . . . . . . . . . . . . L NEAR 0019 CODE +RET. . . . . . . . . . . . . . . L NEAR 00B6 CODE +RETOFF . . . . . . . . . . . . . L WORD 0002 DATA +RETSEG . . . . . . . . . . . . . L WORD 0004 DATA +TYPCNT . . . . . . . . . . . . . L BYTE 000A DATA +TYPLST . . . . . . . . . . . . . L WORD 0002 DATA +TYPTAB . . . . . . . . . . . . . L BYTE 0000 CONST +VALCNT . . . . . . . . . . . . . L BYTE 000B DATA +VALTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +$$CTS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$ERRV . . . . . . . . . . . . . V WORD 0000 DATA External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$TCR. . . . . . . . . . . . . . L NEAR 0000 CODE External +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$BUFLEN. . . . . . . . . . . . . L BYTE 000C DATA Global +$CONT. . . . . . . . . . . . . . L NEAR 0000 CODE External +$FILBUF. . . . . . . . . . . . . L WORD 0000 DATA Global +$FIN . . . . . . . . . . . . . . L NEAR 0000 CODE External +$GETCH . . . . . . . . . . . . . L NEAR 0000 CODE External +$IN0A. . . . . . . . . . . . . . L NEAR 0000 CODE External +$INBUF . . . . . . . . . . . . . L BYTE 000E DATA Global Length =0100 +$INPOVF. . . . . . . . . . . . . L NEAR 00B7 CODE Global +$IPUA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$IPUB. . . . . . . . . . . . . . L NEAR 00C7 CODE Global +$LINLEN. . . . . . . . . . . . . L BYTE 000D DATA Global +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External + + +INPUT - INPUT statement Macro-86 %1(12) 1:3:25 13-Nov-81 Symbols-2 + + + +$REDO. . . . . . . . . . . . . . L FAR 0000 CODE External +$SAS . . . . . . . . . . . . . . L FAR 0000 CODE External +$TYPTX . . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/INPUT.ASM b/3_source_code/BASLIB-86/INPUT.ASM new file mode 100644 index 0000000..1706abc --- /dev/null +++ b/3_source_code/BASLIB-86/INPUT.ASM @@ -0,0 +1,230 @@ + TITLE INPUT - INPUT statement + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC $FILBUF,$INBUF,$BUFLEN,$LINLEN + + EXTRN VALTYP:BYTE,$$ERRV:WORD,$AC:WORD,$PTRFIL:WORD,$$SPSV:WORD + +EOL EQU 0 + +$FILBUF DW ? +LONGRET LABEL DWORD +RETOFF LABEL WORD +TYPLST DW ? ;Share with return addr. offset +RETSEG DW ? +DATAPT DW ? +CLEAN DW ? +TYPCNT DB ? +VALCNT DB ? + +$BUFLEN DB ? +$LINLEN DB ? +$INBUF DB 256 DUP (?) + +DATA ENDS + + +CONST SEGMENT BYTE PUBLIC 'CONST' + +TYPTAB DB 2,4,8,3 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $IPUA,$IPUB,$INPOVF + + EXTRN $TYPTX:NEAR,$FIN:NEAR,$GETCH:NEAR,$IN0A:NEAR,$REDO:FAR + EXTRN $CONT:NEAR,$$CTS:NEAR,$$TCR:NEAR,$SAS:FAR + + ASSUME CS:CODE, DS:DC, ES:DC + +INPUT PROC FAR ;Set up long returns + + +;*** $IPUA - Get input line +; +; Inputs: +; Return address on top of stack is long pointer to list of values to +; input. First byte in list is number of values, following are types of +; each value. Thus the calling sequence looks like this: +; +; CALL $IPUA +; DB +; DB +; DB +; . . . +; DB +; +; +; The type of values are: +; +; 4 = Integer +; 5 = Single precision +; 6 = Double precision +; 7 = String +; +; Function: +; Prompt and read input line, and decode each value, checking to be +; sure everything is OK and types match. If anything goes wrong, print +; "?Redo from start" and start over. Values will be saved on stack, so +; user code must not have anything saved on the stack when this is +; called. Values will be read with $IPUB. +; Outputs: +; None. +; Registers: +; All except BP destroyed. + +$IPUA: + POP DI + POP ES ;ES:DI point to list of types + MOV AL,ES:[DI] ;Get number of values to input + INC DI + MOV [RETSEG],ES + MOV [TYPLST],DI ;If we have to restart, remember start of list + MOV [VALCNT],AL ;Remember number of values + MOV [CLEAN],SP ;Clean stack value + MOV [DATAPT],SP ;Read values back from here +REDO: + MOV [TYPCNT],AL ;Initialize count of values + MOV SI,OFFSET DC:$INBUF +EACHVAL: + MOV AL,ES:[DI] ;Get next type + INC DI + MOV BX,OFFSET DC:TYPTAB-4 ;Convert type so FIN will understand + XLAT + CBW + PUSH AX ;Put type on stack + MOV [VALTYP],AL + PUSH ES + PUSH DI + MOV [$$SPSV],SP ;Save stack address here if error + PUSH DS + POP ES ;ES = DS + PUSH BP + MOV DX,","*256+" " ;Set up numeric delimiters + CMP AL,3 ;Is it string? + JNZ CALLBUF + MOV DL,DH ;Make both delimiters "," +CALLBUF: + CALL [$FILBUF] ;Get a buffer if disk I/O + CALL $FIN ;Get number or string + POP BP + POP DI + POP ES + CMP [VALTYP],4 ;Set flags on type of value + MOV BX,OFFSET DC:$AC + JB PUSHAC ;Don't do high word if integer or string + PUSH [BX+2] ;Push highest word +PUSHAC: + PUSH [BX] + JBE NXTVAL ;Only push low words if D.P. + PUSH [BX-2] + PUSH [BX-4] +NXTVAL: + CMP [$$ERRV],OFFSET $CONT ;See if vector has been changed + JZ CNTDSK ;If not, we're doing disk input + CALL $GETCH ;Skip over blanks, etc. + DEC [TYPCNT] ;Any values left? + JZ CHKEND + CMP AL,"," ;Values must be separated by "," + JZ EACHVAL +INPERR: +;Come here to restart if any error occured + MOV SP,[CLEAN] + CALL $TYPTX + DB "?Redo from star","t"+80H + CALL $$TCR ;Output CR/LF + CALL $REDO ;Get new input line + MOV AL,[VALCNT] ;Re-initialize + LES DI,[LONGRET] + JMP REDO + + +CNTDSK: + DEC [TYPCNT] ;Count the values + JZ donval ;Can't make it all the way + JMP EACHVAL +donval: + XOR AL,AL ;Flag that we reached the end +CHKEND: + OR AL,AL ;Did we reach end of line? + JNZ INPERR + MOV [$$ERRV],OFFSET $CONT ;Restore error vector + PUSH ES + PUSH DI ;Put return address back on stack + PUSH DS + POP ES ;Restore ES +RET: RET + +$INPOVF: +;Come here from error trap if overflow in FIN + CALL $TYPTX + DB "Overflo","w"+80H + CALL $$TCR ;Output CR/LF + JMP INPERR + + +;*** $IPUB - Copy input values into variables +; +; Inputs: +; BX = Address of variable +; Function: +; Recover value input for that variable from the stack and copy it in. +; When last variable has been assigned, recover stack space. +; Outputs: +; None. +; Registers: +; Only F affected. + +$IPUB: + PUSH SI + PUSH DI + PUSH CX + PUSH DS + MOV SI,[DATAPT] ;Get pointer to next value + PUSH SS + POP DS ;Values stored in stack segment + DEC SI + DEC SI ;Point to its type + MOV CX,[SI] ;Type also equals length if numeric + MOV DI,CX + AND DI,NOT 1 ;Clear LSB so DI = length + SUB SI,DI ;Point to its low end + MOV ES:[DATAPT],SI ;For next call + CMP CL,3 ;Type STRING? + JZ ASSTRG ;Go assign string + MOV DI,BX + SHR CX,1 ;Move by words + REP MOVSW ;Assign variable + POP DS +ASSNXT: + POP CX + POP DI + POP SI + DEC [VALCNT] ;Any more to go? + JNZ RET ;If so, we'll wait for next call +;Clean up stack + POP [RETOFF] + POP [RETSEG] + MOV SP,[CLEAN] + JMP [LONGRET] + +ASSTRG: + MOV SI,[SI] ;Get pointer to string descriptor + POP DS + XCHG SI,DX + XCHG DX,BX ;BX has source, DX has destination + CALL $SAS ;Do string assign + MOV BX,DX + MOV DX,SI ;Restore BX and DX + JMP ASSNXT + +INPUT ENDP +CODE ENDS + END From dfb0e7886c85eba5c7fedb7a9a3a58a17f778bde Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 8 Jul 2026 15:58:50 -0700 Subject: [PATCH 30/53] Transcription of Bundle 9 - INPUTF.ASM Code and Listing NOTE there are several extra records in the symbol table that are not in the source code for the listing. This results in "Symbol not defined" error at line 51. This is due to assembler directives to mask the includes. I've found them later in the bundle and will create appropriate include files as I encounter them. --- 2_printed_files/bundle_09/INPUTF.ASM | 301 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/INPUTF.ASM | 77 +++++++ 2 files changed, 378 insertions(+) create mode 100644 2_printed_files/bundle_09/INPUTF.ASM create mode 100644 3_source_code/BASLIB-86/INPUTF.ASM diff --git a/2_printed_files/bundle_09/INPUTF.ASM b/2_printed_files/bundle_09/INPUTF.ASM new file mode 100644 index 0000000..8131d84 --- /dev/null +++ b/2_printed_files/bundle_09/INPUTF.ASM @@ -0,0 +1,301 @@ +INPUTF - INPUT$ function Macro-86 %1(12) 1:3:34 13-Nov-81 Page 1-1 + + + + 1 TITLE INPUTF - INPUT$ function + 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INPUTF - INPUT$ function Macro-86 %1(12) 1:3:34 13-Nov-81 Page 1-2 + + + + 3 .list + 4 + 5 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 6 + 7 EXTRN $$SPSV:WORD,$PTRFIL:WORD + 8 + 9 0000 DATA ENDS + 10 + 11 + 12 DC GROUP DATA + 13 + 14 + 15 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 16 + 17 PUBLIC $IN$ + 18 + 19 EXTRN $GETCHR:NEAR,$FBLOC:NEAR,$$ATS:NEAR + 20 EXTRN $ERC_BFM:NEAR,$ERC_IFN:NEAR + 21 + 22 ASSUME CS:CODE, DS:DC, ES:DC + 23 + 24 + 25 0000 $IN$ PROC FAR + 26 + 27 ;*** $IN$ - INPUT$ function for TTY or disk + 28 ; + 29 ; Inputs: + 30 ; BX = Number of characters wanted + 31 ; DX = File number (32767 for TTY) + 32 ; Function: + 33 ; Create a temp string of length BX, fill with characters from file or + 34 ; from TTY without echo. + 35 ; Outputs: + 36 ; BX = Address of string descriptor + 37 ; Registers: + 38 ; Only BX and F affected. + 39 + 40 0000 89 26 0000 E MOV [$$SPSV],SP + 41 0004 51 PUSH CX + 42 0005 52 PUSH DX + 43 0006 56 PUSH SI + 44 0007 33 F6 XOR SI,SI ;In case TTY input + 45 0009 8B CB MOV CX,BX ;Put count in CX + 46 000B 8B DA MOV BX,DX ;File number in BX + 47 000D 80 FB FF CMP BL,255 + 48 0010 74 0A JZ STOPNT + 49 0012 E8 0000 E CALL $FBLOC + 50 0015 74 20 JZ BADNUM ;Illegal file number + 51 0017 80 3C 02 CMP [SI].FD_MODE,MD_SQO + 52 001A 74 1E JE BADMODE + 53 001C STOPNT: + 54 001C 89 36 0000 E MOV [$PTRFIL],SI + 55 0020 5E POP SI + 56 0021 8B D9 MOV BX,CX + + +INPUTF - INPUT$ function Macro-86 %1(12) 1:3:34 13-Nov-81 Page 1-3 + + + + 57 0023 E8 0000 E CALL $$ATS ;Allocate temp string + 58 0026 E3 0C JCXZ INPOP + 59 0028 87 FA XCHG DI,DX ;Put data pointer in DI + 60 002A 50 PUSH AX + 61 002B RDSTR: + 62 002B E8 0000 E CALL $GETCHR ;Read character + 63 002E AA STOSB ;Put in string + 64 002F E2 FA LOOP RDSTR ;Repeat + 65 0031 58 POP AX + 66 0032 8B FA MOV DI,DX ;Restore DI + 67 0034 INPOP: + 68 0034 5A POP DX + 69 0035 59 POP CX + 70 0036 CB RET + 71 + 72 0037 E9 0000 E BADNUM: JMP $ERC_IFN + 73 003A E9 0000 E BADMODE:JMP $ERC_BFM + 74 + 75 003D $IN$ ENDP + 76 003D CODE ENDS + 77 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INPUTF - INPUT$ function Macro-86 %1(12) 1:3:34 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 003D BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BADMODE. . . . . . . . . . . . . L NEAR 003A CODE +BADNUM . . . . . . . . . . . . . L NEAR 0037 CODE +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE + + +INPUTF - INPUT$ function Macro-86 %1(12) 1:3:34 13-Nov-81 Symbols-2 + + + +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_Width . . . . . . . . . . . . Number 0008 +EOFCHR . . . . . . . . . . . . . Number 001A +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +INPOP. . . . . . . . . . . . . . L NEAR 0034 CODE +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +RDSTR. . . . . . . . . . . . . . L NEAR 002B CODE +REC_LENGTH . . . . . . . . . . . Number 0080 +STOPNT . . . . . . . . . . . . . L NEAR 001C CODE +$$ATS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IFN . . . . . . . . . . . . L NEAR 0000 CODE External +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE External +$GETCHR. . . . . . . . . . . . . L NEAR 0000 CODE External +$IN$ . . . . . . . . . . . . . . F PROC 0000 CODE Global Length =003D +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + + + + diff --git a/3_source_code/BASLIB-86/INPUTF.ASM b/3_source_code/BASLIB-86/INPUTF.ASM new file mode 100644 index 0000000..12b8e10 --- /dev/null +++ b/3_source_code/BASLIB-86/INPUTF.ASM @@ -0,0 +1,77 @@ + TITLE INPUTF - INPUT$ function + + .list + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$SPSV:WORD,$PTRFIL:WORD + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $IN$ + + EXTRN $GETCHR:NEAR,$FBLOC:NEAR,$$ATS:NEAR + EXTRN $ERC_BFM:NEAR,$ERC_IFN:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +$IN$ PROC FAR + +;*** $IN$ - INPUT$ function for TTY or disk +; +; Inputs: +; BX = Number of characters wanted +; DX = File number (32767 for TTY) +; Function: +; Create a temp string of length BX, fill with characters from file or +; from TTY without echo. +; Outputs: +; BX = Address of string descriptor +; Registers: +; Only BX and F affected. + + MOV [$$SPSV],SP + PUSH CX + PUSH DX + PUSH SI + XOR SI,SI ;In case TTY input + MOV CX,BX ;Put count in CX + MOV BX,DX ;File number in BX + CMP BL,255 + JZ STOPNT + CALL $FBLOC + JZ BADNUM ;Illegal file number + CMP [SI].FD_MODE,MD_SQO + JE BADMODE +STOPNT: + MOV [$PTRFIL],SI + POP SI + MOV BX,CX + CALL $$ATS ;Allocate temp string + JCXZ INPOP + XCHG DI,DX ;Put data pointer in DI + PUSH AX +RDSTR: + CALL $GETCHR ;Read character + STOSB ;Put in string + LOOP RDSTR ;Repeat + POP AX + MOV DI,DX ;Restore DI +INPOP: + POP DX + POP CX + RET + +BADNUM: JMP $ERC_IFN +BADMODE:JMP $ERC_BFM + +$IN$ ENDP +CODE ENDS + END From 36810bf16ea819af54ec51753dce2949af478dd8 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 9 Jul 2026 16:53:43 -0700 Subject: [PATCH 31/53] Transcription of Bundle 9 - IODATA.ASM Code and Listing --- 2_printed_files/bundle_09/IODATA.ASM | 360 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/IODATA.ASM | 139 +++++++++++ 2 files changed, 499 insertions(+) create mode 100644 2_printed_files/bundle_09/IODATA.ASM create mode 100644 3_source_code/BASLIB-86/IODATA.ASM diff --git a/2_printed_files/bundle_09/IODATA.ASM b/2_printed_files/bundle_09/IODATA.ASM new file mode 100644 index 0000000..75c4c2e --- /dev/null +++ b/2_printed_files/bundle_09/IODATA.ASM @@ -0,0 +1,360 @@ +IODATA - Common data for input and output Macro-86 %1(12) 1:3:45 13-Nov-81 Page 1-1 + + + + 1 TITLE IODATA - Common data for input and output + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 PUBLIC VALTYP,CURTYP,TYP + 6 + 7 0000 TYP LABEL WORD + 8 0000 ?? VALTYP DB ? + 9 0001 ?? CURTYP DB ? + 10 + 11 0002 DATA ENDS + 12 + 13 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 14 + 15 PUBLIC PWR10TAB,$ONE,$DBLONE + 16 + 17 ;PWR10TAB - Double precision table of powers of 10 + 18 + 19 ; DB 018H,0C4H,0B6H,07BH,073H,0EDH,01CH,04AH ;1E-55 + 20 ; DB 01EH,075H,0A4H,05AH,0D0H,028H,044H,04DH ;1E-54 + 21 ; DB 065H,092H,04DH,071H,004H,033H,075H,050H ;1E-53 + 22 ; DB 07FH,07BH,0D0H,0C6H,0E2H,03FH,019H,054H ;1E-52 + 23 ; DB 05FH,09AH,084H,078H,0DBH,08FH,03FH,057H ;1E-51 + 24 ; DB 0F7H,0C0H,0A5H,056H,0D2H,073H,06FH,05AH ;1E-50 + 25 ; DB 09AH,098H,027H,076H,063H,0A8H,015H,05EH ;1E-49 + 26 ; DB 0C1H,07EH,0B1H,053H,07CH,012H,03BH,061H ;1E-48 + 27 ; DB 071H,0DEH,09DH,068H,01BH,0D7H,069H,064H ;1E-47 + 28 ; DB 007H,0ABH,062H,021H,071H,026H,012H,068H ;1E-46 + 29 ; DB 0C9H,055H,0BBH,069H,00DH,0B0H,036H,06BH ;1E-45 + 30 ; DB 03BH,02BH,02AH,0C4H,010H,05CH,064H,06EH ;1E-44 + 31 ; DB 005H,05BH,09AH,07AH,08AH,0B9H,00EH,072H ;1E-43 + 32 ; DB 0C6H,0F1H,040H,019H,0EDH,067H,032H,075H ;1E-42 + 33 ; DB 037H,02EH,091H,05FH,0E8H,001H,05FH,078H ;1E-41 + 34 ; DB 0E3H,0BCH,0BAH,03BH,031H,061H,00BH,07CH ;1E-40 + 35 ; DB 01BH,06CH,0A9H,08AH,07DH,039H,02EH,07FH ;1E-39 + 36 + 37 ; The powers of 10 below have been checked with MuMath + 38 + 39 ; DB 022H,0C7H,053H,0EDH,0DCH,0C7H,059H,002H ;1E-38 + 40 ; DB 075H,05CH,054H,014H,0EAH,01CH,008H,006H ;1E-37 + 41 ; DB 093H,073H,069H,099H,024H,024H,02AH,009H ;1E-36 + 42 ; DB 078H,0D0H,0C3H,0BFH,02DH,0ADH,054H,00CH ;1E-35 + 43 ; DB 04BH,062H,0DAH,097H,03CH,0ECH,004H,010H ;1E-34 + 44 ; DB 0DDH,0FAH,0D0H,0BDH,04BH,027H,026H,013H ;1E-33 + 45 ; DB 095H,039H,045H,0ADH,01EH,0B1H,04FH,016H ;1E-32 + 46 ; DB 0FDH,043H,04BH,02CH,0B3H,0CEH,001H,01AH ;1E-31 + 47 0000 FC 14 5E F7 5F 42 DB 0FCH,014H,05EH,0F7H,05FH,042H,022H,01DH ;1E-30 + 48 22 1D + 49 0008 3B 9A 35 F5 F7 D2 DB 03BH,09AH,035H,0F5H,0F7H,0D2H,04AH,020H ;1E-29 + 50 4A 20 + 51 0010 CA 00 83 F2 B5 87 DB 0CAH,000H,083H,0F2H,0B5H,087H,07DH,023H ;1E-28 + 52 7D 23 + 53 0018 7E E0 91 B7 D1 74 DB 07EH,0E0H,091H,0B7H,0D1H,074H,01EH,027H ;1E-27 + 54 1E 27 + + +IODATA - Common data for input and output Macro-86 %1(12) 1:3:45 13-Nov-81 Page 1-2 + + + + 55 0020 9E 58 76 25 06 12 DB 09EH,058H,076H,025H,006H,012H,046H,02AH ;1E-26 + 56 46 2A + 57 0028 C5 EE D3 AE 87 96 DB 0C5H,0EEH,0D3H,0AEH,087H,096H,077H,02DH ;1E-25 + 58 77 2D + 59 0030 3B 75 44 CD 14 BE DB 03BH,075H,044H,0CDH,014H,0BEH,01AH,031H ;1E-24 + 60 1A 31 + 61 0038 8A 92 95 00 9A 6D DB 08AH,092H,095H,000H,09AH,06DH,041H,034H ;1E-23 + 62 41 34 + 63 0040 2D F7 BA 80 00 C9 DB 02DH,0F7H,0BAH,080H,000H,0C9H,071H,037H ;1E-22 + 64 71 37 + 65 0048 7C DA 74 50 A0 1D DB 07CH,0DAH,074H,050H,0A0H,01DH,017H,03BH ;1E-21 + 66 17 3B + 67 0050 1B 11 92 64 08 E5 DB 01BH,011H,092H,064H,008H,0E5H,03CH,03EH ;1E-20 + 68 3C 3E + 69 0058 62 95 B6 7D 4A 1E DB 062H,095H,0B6H,07DH,04AH,01EH,06CH,041H ;1E-19 + 70 6C 41 + 71 0060 5D 1D 92 8E EE 92 DB 05DH,01DH,092H,08EH,0EEH,092H,013H,045H ;1E-18 + 72 13 45 + 73 0068 B4 A4 36 32 AA 77 DB 0B4H,0A4H,036H,032H,0AAH,077H,038H,048H ;1E-17 + 74 38 48 + 75 0070 E1 4D C4 BE 94 95 DB 0E1H,04DH,0C4H,0BEH,094H,095H,066H,04BH ;1E-16 + 76 66 4B + 77 0078 AD B0 3A F7 7C 1D DB 0ADH,0B0H,03AH,0F7H,07CH,01DH,010H,04FH ;1E-15 + 78 10 4F + 79 0080 D8 5C 09 35 DC 24 DB 0D8H,05CH,009H,035H,0DCH,024H,034H,052H ;1E-14 + 80 34 52 + 81 0088 0E B4 4B 42 13 2E DB 00EH,0B4H,04BH,042H,013H,02EH,061H,055H ;1E-13 + 82 61 55 + 83 0090 89 50 6F 09 CC BC DB 089H,050H,06FH,009H,0CCH,0BCH,00CH,059H ;1E-12 + 84 0C 59 + 85 0098 AB 24 CB 0B FF EB DB 0ABH,024H,0CBH,00BH,0FFH,0EBH,02FH,05CH ;1E-11 + 86 2F 5C + 87 00A0 D6 ED BD CE FE E6 DB 0D6H,0EDH,0BDH,0CEH,0FEH,0E6H,05BH,05FH ;1E-10 + 88 5B 5F + 89 00A8 A6 B4 36 41 5F 70 DB 0A6H,0B4H,036H,041H,05FH,070H,009H,063H ;1E-9 + 90 09 63 + 91 00B0 CF 61 84 11 77 CC DB 0CFH,061H,084H,011H,077H,0CCH,02BH,066H ;1E-8 + 92 2B 66 + 93 00B8 43 7A E5 D5 94 BF DB 043H,07AH,0E5H,0D5H,094H,0BFH,056H,069H ;1E-7 + 94 56 69 + 95 00C0 6A 6C AF 05 BD 37 DB 06AH,06CH,0AFH,005H,0BDH,037H,006H,06DH ;1E-6 + 96 06 6D + 97 00C8 84 47 1B 47 AC C5 DB 084H,047H,01BH,047H,0ACH,0C5H,027H,070H ;1E-5 + 98 27 70 + 99 00D0 65 19 E2 58 17 B7 DB 065H,019H,0E2H,058H,017H,0B7H,051H,073H ;1E-4 + 100 51 73 + 101 00D8 DF 4F 8D 97 6E 12 DB 0DFH,04FH,08DH,097H,06EH,012H,003H,077H ;1E-3 + 102 03 77 + 103 00E0 D7 A3 70 3D 0A D7 DB 0D7H,0A3H,070H,03DH,00AH,0D7H,023H,07AH ;1E-2 + 104 23 7A + 105 00E8 CD CC CC CC CC CC DB 0CDH,0CCH,0CCH,0CCH,0CCH,0CCH,04CH,07DH ;1E-1 + 106 4C 7D + 107 00F0 PWR10TAB LABEL BYTE + 108 00F0 00 00 00 00 $DBLONE DB 000H,000H,000H,000H + + +IODATA - Common data for input and output Macro-86 %1(12) 1:3:45 13-Nov-81 Page 1-3 + + + + 109 00F4 00 00 00 00 $ONE DB 000H,000H,000H,000H ;1E0 + 110 00F8 00 00 00 00 00 00 DB 000H,000H,000H,000H,000H,000H,020H,084H ;1E1 + 111 20 84 + 112 0100 00 00 00 00 00 00 DB 000H,000H,000H,000H,000H,000H,048H,087H ;1E2 + 113 48 87 + 114 0108 00 00 00 00 00 00 DB 000H,000H,000H,000H,000H,000H,07AH,08AH ;1E3 + 115 7A 8A + 116 0110 00 00 00 00 00 40 DB 000H,000H,000H,000H,000H,040H,01CH,08EH ;1E4 + 117 1C 8E + 118 0118 00 00 00 00 00 50 DB 000H,000H,000H,000H,000H,050H,043H,091H ;1E5 + 119 43 91 + 120 0120 00 00 00 00 00 24 DB 000H,000H,000H,000H,000H,024H,074H,094H ;1E6 + 121 74 94 + 122 0128 00 00 00 00 80 96 DB 000H,000H,000H,000H,080H,096H,018H,098H ;1E7 + 123 18 98 + 124 0130 00 00 00 00 20 BC DB 000H,000H,000H,000H,020H,0BCH,03EH,09BH ;1E8 + 125 3E 9B + 126 0138 00 00 00 00 28 6B DB 000H,000H,000H,000H,028H,06BH,06EH,09EH ;1E9 + 127 6E 9E + 128 0140 00 00 00 00 F9 02 DB 000H,000H,000H,000H,0F9H,002H,015H,0A2H ;1E10 + 129 15 A2 + 130 0148 00 00 00 40 B7 43 DB 000H,000H,000H,040H,0B7H,043H,03AH,0A5H ;1E11 + 131 3A A5 + 132 0150 00 00 00 10 A5 D4 DB 000H,000H,000H,010H,0A5H,0D4H,068H,0A8H ;1E12 + 133 68 A8 + 134 0158 00 00 00 2A E7 84 DB 000H,000H,000H,02AH,0E7H,084H,011H,0ACH ;1E13 + 135 11 AC + 136 0160 00 00 80 F4 20 E6 DB 000H,000H,080H,0F4H,020H,0E6H,035H,0AFH ;1E14 + 137 35 AF + 138 0168 00 00 A0 31 A9 5F DB 000H,000H,0A0H,031H,0A9H,05FH,063H,0B2H ;1E15 + 139 63 B2 + 140 0170 00 00 04 BF C9 1B DB 000H,000H,004H,0BFH,0C9H,01BH,00EH,0B6H ;1E16 + 141 0E B6 + 142 0178 00 00 C5 2E BC A2 DB 000H,000H,0C5H,02EH,0BCH,0A2H,031H,0B9H ;1E17 + 143 31 B9 + 144 0180 00 40 76 3A 6B 0B DB 000H,040H,076H,03AH,06BH,00BH,05EH,0BCH ;1E18 + 145 5E BC + 146 0188 00 E8 89 04 23 C7 DB 000H,0E8H,089H,004H,023H,0C7H,00AH,0C0H ;1E19 + 147 0A C0 + 148 0190 00 62 AC C5 EB 78 DB 000H,062H,0ACH,0C5H,0EBH,078H,02DH,0C3H ;1E20 + 149 2D C3 + 150 0198 80 7A 17 B7 26 D7 DB 080H,07AH,017H,0B7H,026H,0D7H,058H,0C6H ;1E21 + 151 58 C6 + 152 01A0 90 AC 6E 32 78 86 DB 090H,0ACH,06EH,032H,078H,086H,007H,0CAH ;1E22 + 153 07 CA + 154 01A8 B4 57 0A 3F 16 68 DB 0B4H,057H,00AH,03FH,016H,068H,029H,0CDH ;1E23 + 155 29 CD + 156 01B0 A1 ED CC CE 1B C2 DB 0A1H,0EDH,0CCH,0CEH,01BH,0C2H,053H,0D0H ;1E24 + 157 53 D0 + 158 01B8 85 14 40 61 51 59 DB 085H,014H,040H,061H,051H,059H,004H,0D4H ;1E25 + 159 04 D4 + 160 01C0 A6 19 90 B9 A5 6F DB 0A6H,019H,090H,0B9H,0A5H,06FH,025H,0D7H ;1E26 + 161 25 D7 + 162 01C8 0F 20 F4 27 8F CB DB 00FH,020H,0F4H,027H,08FH,0CBH,04EH,0DAH ;1E27 + + +IODATA - Common data for input and output Macro-86 %1(12) 1:3:45 13-Nov-81 Page 1-4 + + + + 163 4E DA + 164 01D0 0A 94 F8 78 39 3F DB 00AH,094H,0F8H,078H,039H,03FH,001H,0DEH ;1E28 + 165 01 DE + 166 01D8 0C B9 36 D7 07 8F DB 00CH,0B9H,036H,0D7H,007H,08FH,021H,0E1H ;1E29 + 167 21 E1 + 168 01E0 4F 67 04 CD C9 F2 DB 04FH,067H,004H,0CDH,0C9H,0F2H,049H,0E4H ;1E30 + 169 49 E4 + 170 01E8 23 81 45 40 7C 6F DB 023H,081H,045H,040H,07CH,06FH,07CH,0E7H ;1E31 + 171 7C E7 + 172 01F0 B6 70 2B A8 AD C5 DB 0B6H,070H,02BH,0A8H,0ADH,0C5H,01DH,0EBH ;1E32 + 173 1D EB + 174 01F8 E3 4C 36 12 19 37 DB 0E3H,04CH,036H,012H,019H,037H,045H,0EEH ;1E33 + 175 45 EE + 176 0200 1C E0 C3 56 DF 84 DB 01CH,0E0H,0C3H,056H,0DFH,084H,076H,0F1H ;1E34 + 177 76 F1 + 178 0208 11 6C 3A 96 0B 13 DB 011H,06CH,03AH,096H,00BH,013H,01AH,0F5H ;1E35 + 179 1A F5 + 180 0210 16 07 C9 7B CE 97 DB 016H,007H,0C9H,07BH,0CEH,097H,040H,0F8H ;1E36 + 181 40 F8 + 182 0218 DB 48 BB 1A C2 BD DB 0DBH,048H,0BBH,01AH,0C2H,0BDH,070H,0FBH ;1E37 + 183 70 FB + 184 0220 89 0D B5 50 99 76 DB 089H,00DH,0B5H,050H,099H,076H,016H,0FFH ;1E38 + 185 16 FF + 186 0228 EB 50 E2 A4 3F 14 DB 0EBH,050H,0E2H,0A4H,03FH,014H,03CH,082H ;1E39 + 187 3C 82 + 188 0230 26 E5 1A 8E 4F 19 DB 026H,0E5H,01AH,08EH,04FH,019H,06BH,085H ;1E40 + 189 6B 85 + 190 0238 38 CF D0 B8 D1 EF DB 038H,0CFH,0D0H,0B8H,0D1H,0EFH,012H,089H ;1E41 + 191 12 89 + 192 0240 06 03 05 27 C6 AB DB 006H,003H,005H,027H,0C6H,0ABH,037H,08CH ;1E42 + 193 37 8C + 194 0248 C7 43 C6 B0 B7 96 DB 0C7H,043H,0C6H,0B0H,0B7H,096H,065H,08FH ;1E43 + 195 65 8F + 196 0250 5C EA 7B CE 32 7E DB 05CH,0EAH,07BH,0CEH,032H,07EH,00FH,093H ;1E44 + 197 0F 93 + 198 0258 F4 E4 1A 82 BF 5D DB 0F4H,0E4H,01AH,082H,0BFH,05DH,033H,096H ;1E45 + 199 33 96 + 200 0260 30 9E A1 62 2F 35 DB 030H,09EH,0A1H,062H,02FH,035H,060H,099H ;1E46 + 201 60 99 + 202 0268 DE 02 A5 9D 3D 21 DB 0DEH,002H,0A5H,09DH,03DH,021H,00CH,09DH ;1E47 + 203 0C 9D + 204 0270 96 43 0E 05 8D 29 DB 096H,043H,00EH,005H,08DH,029H,02FH,0A0H ;1E48 + 205 2F A0 + 206 0278 7B D4 51 46 F0 F3 DB 07BH,0D4H,051H,046H,0F0H,0F3H,05AH,0A3H ;1E49 + 207 5A A3 + 208 0280 CD 24 F3 2B 76 D8 DB 0CDH,024H,0F3H,02BH,076H,0D8H,008H,0A7H ;1E50 + 209 08 A7 + 210 0288 00 EE EF B6 93 0E DB 000H,0EEH,0EFH,0B6H,093H,00EH,02BH,0AAH ;1E51 + 211 2B AA + 212 0290 80 E9 AB A4 38 D2 DB 080H,0E9H,0ABH,0A4H,038H,0D2H,055H,0ADH ;1E52 + 213 55 AD + 214 0298 F0 71 EB 66 63 A3 DB 0F0H,071H,0EBH,066H,063H,0A3H,005H,0B1H ;1E53 + 215 05 B1 + 216 02A0 6C 4E A6 40 3C 0C DB 06CH,04EH,0A6H,040H,03CH,00CH,027H,0B4H ;1E54 + + +IODATA - Common data for input and output Macro-86 %1(12) 1:3:45 13-Nov-81 Page 1-5 + + + + 217 27 B4 + 218 02A8 07 E2 CF 50 4B CF DB 007H,0E2H,0CFH,050H,04BH,0CFH,050H,0B7H ;1E55 + 219 50 B7 + 220 02B0 45 ED 81 12 8F 81 DB 045H,0EDH,081H,012H,08FH,081H,002H,0BBH ;1E56 + 221 02 BB + 222 + 223 02B8 CONST ENDS + 224 + 225 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODATA - Common data for input and output Macro-86 %1(12) 1:3:45 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CONST. . . . . . . . . . . . . . 02B8 WORD PUBLIC 'CONST' +DATA . . . . . . . . . . . . . . 0002 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +CURTYP . . . . . . . . . . . . . L BYTE 0001 DATA Global +PWR10TAB . . . . . . . . . . . . L BYTE 00F0 CONST Global +TYP. . . . . . . . . . . . . . . L WORD 0000 DATA Global +VALTYP . . . . . . . . . . . . . L BYTE 0000 DATA Global +$DBLONE. . . . . . . . . . . . . L BYTE 00F0 CONST Global +$ONE . . . . . . . . . . . . . . L BYTE 00F4 CONST Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/IODATA.ASM b/3_source_code/BASLIB-86/IODATA.ASM new file mode 100644 index 0000000..f2d0a58 --- /dev/null +++ b/3_source_code/BASLIB-86/IODATA.ASM @@ -0,0 +1,139 @@ + TITLE IODATA - Common data for input and output + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC VALTYP,CURTYP,TYP + +TYP LABEL WORD +VALTYP DB ? +CURTYP DB ? + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + PUBLIC PWR10TAB,$ONE,$DBLONE + +;PWR10TAB - Double precision table of powers of 10 + +; DB 018H,0C4H,0B6H,07BH,073H,0EDH,01CH,04AH ;1E-55 +; DB 01EH,075H,0A4H,05AH,0D0H,028H,044H,04DH ;1E-54 +; DB 065H,092H,04DH,071H,004H,033H,075H,050H ;1E-53 +; DB 07FH,07BH,0D0H,0C6H,0E2H,03FH,019H,054H ;1E-52 +; DB 05FH,09AH,084H,078H,0DBH,08FH,03FH,057H ;1E-51 +; DB 0F7H,0C0H,0A5H,056H,0D2H,073H,06FH,05AH ;1E-50 +; DB 09AH,098H,027H,076H,063H,0A8H,015H,05EH ;1E-49 +; DB 0C1H,07EH,0B1H,053H,07CH,012H,03BH,061H ;1E-48 +; DB 071H,0DEH,09DH,068H,01BH,0D7H,069H,064H ;1E-47 +; DB 007H,0ABH,062H,021H,071H,026H,012H,068H ;1E-46 +; DB 0C9H,055H,0BBH,069H,00DH,0B0H,036H,06BH ;1E-45 +; DB 03BH,02BH,02AH,0C4H,010H,05CH,064H,06EH ;1E-44 +; DB 005H,05BH,09AH,07AH,08AH,0B9H,00EH,072H ;1E-43 +; DB 0C6H,0F1H,040H,019H,0EDH,067H,032H,075H ;1E-42 +; DB 037H,02EH,091H,05FH,0E8H,001H,05FH,078H ;1E-41 +; DB 0E3H,0BCH,0BAH,03BH,031H,061H,00BH,07CH ;1E-40 +; DB 01BH,06CH,0A9H,08AH,07DH,039H,02EH,07FH ;1E-39 + +; The powers of 10 below have been checked with MuMath + +; DB 022H,0C7H,053H,0EDH,0DCH,0C7H,059H,002H ;1E-38 +; DB 075H,05CH,054H,014H,0EAH,01CH,008H,006H ;1E-37 +; DB 093H,073H,069H,099H,024H,024H,02AH,009H ;1E-36 +; DB 078H,0D0H,0C3H,0BFH,02DH,0ADH,054H,00CH ;1E-35 +; DB 04BH,062H,0DAH,097H,03CH,0ECH,004H,010H ;1E-34 +; DB 0DDH,0FAH,0D0H,0BDH,04BH,027H,026H,013H ;1E-33 +; DB 095H,039H,045H,0ADH,01EH,0B1H,04FH,016H ;1E-32 +; DB 0FDH,043H,04BH,02CH,0B3H,0CEH,001H,01AH ;1E-31 + DB 0FCH,014H,05EH,0F7H,05FH,042H,022H,01DH ;1E-30 + DB 03BH,09AH,035H,0F5H,0F7H,0D2H,04AH,020H ;1E-29 + DB 0CAH,000H,083H,0F2H,0B5H,087H,07DH,023H ;1E-28 + DB 07EH,0E0H,091H,0B7H,0D1H,074H,01EH,027H ;1E-27 + DB 09EH,058H,076H,025H,006H,012H,046H,02AH ;1E-26 + DB 0C5H,0EEH,0D3H,0AEH,087H,096H,077H,02DH ;1E-25 + DB 03BH,075H,044H,0CDH,014H,0BEH,01AH,031H ;1E-24 + DB 08AH,092H,095H,000H,09AH,06DH,041H,034H ;1E-23 + DB 02DH,0F7H,0BAH,080H,000H,0C9H,071H,037H ;1E-22 + DB 07CH,0DAH,074H,050H,0A0H,01DH,017H,03BH ;1E-21 + DB 01BH,011H,092H,064H,008H,0E5H,03CH,03EH ;1E-20 + DB 062H,095H,0B6H,07DH,04AH,01EH,06CH,041H ;1E-19 + DB 05DH,01DH,092H,08EH,0EEH,092H,013H,045H ;1E-18 + DB 0B4H,0A4H,036H,032H,0AAH,077H,038H,048H ;1E-17 + DB 0E1H,04DH,0C4H,0BEH,094H,095H,066H,04BH ;1E-16 + DB 0ADH,0B0H,03AH,0F7H,07CH,01DH,010H,04FH ;1E-15 + DB 0D8H,05CH,009H,035H,0DCH,024H,034H,052H ;1E-14 + DB 00EH,0B4H,04BH,042H,013H,02EH,061H,055H ;1E-13 + DB 089H,050H,06FH,009H,0CCH,0BCH,00CH,059H ;1E-12 + DB 0ABH,024H,0CBH,00BH,0FFH,0EBH,02FH,05CH ;1E-11 + DB 0D6H,0EDH,0BDH,0CEH,0FEH,0E6H,05BH,05FH ;1E-10 + DB 0A6H,0B4H,036H,041H,05FH,070H,009H,063H ;1E-9 + DB 0CFH,061H,084H,011H,077H,0CCH,02BH,066H ;1E-8 + DB 043H,07AH,0E5H,0D5H,094H,0BFH,056H,069H ;1E-7 + DB 06AH,06CH,0AFH,005H,0BDH,037H,006H,06DH ;1E-6 + DB 084H,047H,01BH,047H,0ACH,0C5H,027H,070H ;1E-5 + DB 065H,019H,0E2H,058H,017H,0B7H,051H,073H ;1E-4 + DB 0DFH,04FH,08DH,097H,06EH,012H,003H,077H ;1E-3 + DB 0D7H,0A3H,070H,03DH,00AH,0D7H,023H,07AH ;1E-2 + DB 0CDH,0CCH,0CCH,0CCH,0CCH,0CCH,04CH,07DH ;1E-1 +PWR10TAB LABEL BYTE +$DBLONE DB 000H,000H,000H,000H +$ONE DB 000H,000H,000H,000H ;1E0 + DB 000H,000H,000H,000H,000H,000H,020H,084H ;1E1 + DB 000H,000H,000H,000H,000H,000H,048H,087H ;1E2 + DB 000H,000H,000H,000H,000H,000H,07AH,08AH ;1E3 + DB 000H,000H,000H,000H,000H,040H,01CH,08EH ;1E4 + DB 000H,000H,000H,000H,000H,050H,043H,091H ;1E5 + DB 000H,000H,000H,000H,000H,024H,074H,094H ;1E6 + DB 000H,000H,000H,000H,080H,096H,018H,098H ;1E7 + DB 000H,000H,000H,000H,020H,0BCH,03EH,09BH ;1E8 + DB 000H,000H,000H,000H,028H,06BH,06EH,09EH ;1E9 + DB 000H,000H,000H,000H,0F9H,002H,015H,0A2H ;1E10 + DB 000H,000H,000H,040H,0B7H,043H,03AH,0A5H ;1E11 + DB 000H,000H,000H,010H,0A5H,0D4H,068H,0A8H ;1E12 + DB 000H,000H,000H,02AH,0E7H,084H,011H,0ACH ;1E13 + DB 000H,000H,080H,0F4H,020H,0E6H,035H,0AFH ;1E14 + DB 000H,000H,0A0H,031H,0A9H,05FH,063H,0B2H ;1E15 + DB 000H,000H,004H,0BFH,0C9H,01BH,00EH,0B6H ;1E16 + DB 000H,000H,0C5H,02EH,0BCH,0A2H,031H,0B9H ;1E17 + DB 000H,040H,076H,03AH,06BH,00BH,05EH,0BCH ;1E18 + DB 000H,0E8H,089H,004H,023H,0C7H,00AH,0C0H ;1E19 + DB 000H,062H,0ACH,0C5H,0EBH,078H,02DH,0C3H ;1E20 + DB 080H,07AH,017H,0B7H,026H,0D7H,058H,0C6H ;1E21 + DB 090H,0ACH,06EH,032H,078H,086H,007H,0CAH ;1E22 + DB 0B4H,057H,00AH,03FH,016H,068H,029H,0CDH ;1E23 + DB 0A1H,0EDH,0CCH,0CEH,01BH,0C2H,053H,0D0H ;1E24 + DB 085H,014H,040H,061H,051H,059H,004H,0D4H ;1E25 + DB 0A6H,019H,090H,0B9H,0A5H,06FH,025H,0D7H ;1E26 + DB 00FH,020H,0F4H,027H,08FH,0CBH,04EH,0DAH ;1E27 + DB 00AH,094H,0F8H,078H,039H,03FH,001H,0DEH ;1E28 + DB 00CH,0B9H,036H,0D7H,007H,08FH,021H,0E1H ;1E29 + DB 04FH,067H,004H,0CDH,0C9H,0F2H,049H,0E4H ;1E30 + DB 023H,081H,045H,040H,07CH,06FH,07CH,0E7H ;1E31 + DB 0B6H,070H,02BH,0A8H,0ADH,0C5H,01DH,0EBH ;1E32 + DB 0E3H,04CH,036H,012H,019H,037H,045H,0EEH ;1E33 + DB 01CH,0E0H,0C3H,056H,0DFH,084H,076H,0F1H ;1E34 + DB 011H,06CH,03AH,096H,00BH,013H,01AH,0F5H ;1E35 + DB 016H,007H,0C9H,07BH,0CEH,097H,040H,0F8H ;1E36 + DB 0DBH,048H,0BBH,01AH,0C2H,0BDH,070H,0FBH ;1E37 + DB 089H,00DH,0B5H,050H,099H,076H,016H,0FFH ;1E38 + DB 0EBH,050H,0E2H,0A4H,03FH,014H,03CH,082H ;1E39 + DB 026H,0E5H,01AH,08EH,04FH,019H,06BH,085H ;1E40 + DB 038H,0CFH,0D0H,0B8H,0D1H,0EFH,012H,089H ;1E41 + DB 006H,003H,005H,027H,0C6H,0ABH,037H,08CH ;1E42 + DB 0C7H,043H,0C6H,0B0H,0B7H,096H,065H,08FH ;1E43 + DB 05CH,0EAH,07BH,0CEH,032H,07EH,00FH,093H ;1E44 + DB 0F4H,0E4H,01AH,082H,0BFH,05DH,033H,096H ;1E45 + DB 030H,09EH,0A1H,062H,02FH,035H,060H,099H ;1E46 + DB 0DEH,002H,0A5H,09DH,03DH,021H,00CH,09DH ;1E47 + DB 096H,043H,00EH,005H,08DH,029H,02FH,0A0H ;1E48 + DB 07BH,0D4H,051H,046H,0F0H,0F3H,05AH,0A3H ;1E49 + DB 0CDH,024H,0F3H,02BH,076H,0D8H,008H,0A7H ;1E50 + DB 000H,0EEH,0EFH,0B6H,093H,00EH,02BH,0AAH ;1E51 + DB 080H,0E9H,0ABH,0A4H,038H,0D2H,055H,0ADH ;1E52 + DB 0F0H,071H,0EBH,066H,063H,0A3H,005H,0B1H ;1E53 + DB 06CH,04EH,0A6H,040H,03CH,00CH,027H,0B4H ;1E54 + DB 007H,0E2H,0CFH,050H,04BH,0CFH,050H,0B7H ;1E55 + DB 045H,0EDH,081H,012H,08FH,081H,002H,0BBH ;1E56 + +CONST ENDS + + END From 47a7563607bb2f50abca8d62f45cb7164de06929 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 10 Jul 2026 18:47:42 -0700 Subject: [PATCH 32/53] Transcription of Bundle 9 - IODEV.ASM Code and Listing Created file TABMAC.INC from listing, required for build. (See line 8 for include statement, lines 9-31 for content) Created file DEVDEF.INC from listing, required for build. (See line 32 for include statement, lines 33-204 for content) DEVDEF.INC includes SYSTEM.INC, which was added previously. DEVDEF.INC is silently included in some previously transcribed files and noted with their commit notes. Including it will fix the errors I called out. --- 2_printed_files/bundle_09/IODEV.ASM | 1920 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/DEVDEF.INC | 131 ++ 3_source_code/BASLIB-86/IODEV.ASM | 864 ++++++++++++ 3_source_code/BASLIB-86/TABMAC.INC | 23 + 4 files changed, 2938 insertions(+) create mode 100644 2_printed_files/bundle_09/IODEV.ASM create mode 100644 3_source_code/BASLIB-86/DEVDEF.INC create mode 100644 3_source_code/BASLIB-86/IODEV.ASM create mode 100644 3_source_code/BASLIB-86/TABMAC.INC diff --git a/2_printed_files/bundle_09/IODEV.ASM b/2_printed_files/bundle_09/IODEV.ASM new file mode 100644 index 0000000..1325551 --- /dev/null +++ b/2_printed_files/bundle_09/IODEV.ASM @@ -0,0 +1,1920 @@ +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-1 + + + + 1 TITLE IODEV - Device Independent I/O Drivers for BASCOM-86 + 2 + 3 + 4 ; This module contains the device independent I/O drivers for the + 5 ; 8086 BASIC Compiler runtime. + 6 + 7 + 8 C INCLUDE TABMAC.INC + 9 C ; Special Table Generation Macros + 10 C + 11 C ENTORG MACRO First_entry + 12 C .XCREF + 13 C ___ZZZ= First_entry + 14 C .CREF + 15 C ENDM + 16 C + 17 C + 18 C ENT MACRO Lab,Incr + 19 C Lab= ___ZZZ + 20 C .XCREF + 21 C ___ZZZ= ___ZZZ+Incr + 22 C .CREF + 23 C ENDM + 24 C + 25 C + 26 C ENTI MACRO Incr + 27 C .XCREF + 28 C ___ZZZ= ___ZZZ+Incr + 29 C .CREF + 30 C ENDM + 31 C + 32 C INCLUDE DEVDEF.INC + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-2 + + + + 33 C PAGE + 34 C + 35 C ; DEVDEF.INC - Device Independent I/O Definitions + 36 C + 37 C INCLUDE SYSTEM.INC + 38 C ; Operating System Selection + 39 C + 40 = 0000 C _IBM_= 0 + 41 C + 42 = 0001 C _MSDOS_= 1 + 43 = 0000 C _CPM_= 0 + 44 C + 45 C ; Overrides + 46 C + 47 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ + 48 C + 49 C if1 + 50 C if _CPM_ + 51 C %OUT ! CP/M-86 Version + 52 C endif + 53 C if _MSDOS_ + 54 C %OUT ! MSDOS Version + 55 C endif + 56 C if _IBM_ + 57 C %OUT ! IBM Personal Computer + 58 C endif + 59 C + 60 C if _MSDOS_+_CPM_ ne 1 + 61 C %OUT ##################### Error - Bad Operating System Selection + 62 C + 63 C error + 64 C endif + 65 C endif + 66 C + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-3 + + + + 67 C PAGE + 68 C + 69 C DEVNAM MACRO + 70 C DEVMAC KYBD + 71 C DEVMAC SCRN + 72 C if _IBM_ + 73 C DEVMAC CAS1 + 74 C DEVMAC COM1 + 75 C DEVMAC COM2 + 76 C endif + 77 C DEVMAC LPT1 + 78 C if _IBM_ + 79 C DEVMAC LPT2 + 80 C DEVMAC LPT3 + 81 C endif + 82 C ENDM + 83 C + 84 = FFFF C ___DEV= -1 + 85 C + 86 C DEVMAC MACRO ARG + 87 C DN_&ARG= ___DEV + 88 C .xcref + 89 C ___DEV= ___DEV-1 + 90 C .cref + 91 C ENDM + 92 C + 93 C DEVNAM + 94 C + 95 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-4 + + + + 96 C PAGE + 97 C + 98 C DSPNAM MACRO + 99 C DSPMAC EOF ;EOF function + 100 C DSPMAC LOC ;LOC function + 101 C DSPMAC LOF ;LOF function + 102 C ; DSPMAC POS ;POS function + 103 C DSPMAC CLOSE ;CLOSE statement + 104 C DSPMAC WIDTH ;WIDTH statement + 105 C DSPMAC RANDIO ;GET/PUT statements + 106 C DSPMAC OPEN ;OPEN statement + 107 C DSPMAC BAKC ;Backup character + 108 C DSPMAC SINP ;Serial input + 109 C DSPMAC SOUT ;Serial output + 110 C DSPMAC GPOS ;Get current position + 111 C DSPMAC GWID ;Get current width + 112 C ENDM + 113 C + 114 C + 115 C ; Device Function Dispatch Table Offsets + 116 C + 117 C + 118 C DSPMAC MACRO func + 119 C ENT DV_&func,2 + 120 C ENDM + 121 C + 122 C + 123 C ENTORG 0 + 124 C DSPNAM + 125 C ENT DV_TABLEN,0 + 126 C + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-5 + + + + 127 C PAGE + 128 C + 129 C ; File Mode Definitions + 130 C + 131 = 0001 C MD_SQI EQU 1 + 132 = 0002 C MD_SQO EQU 2 + 133 = 0004 C MD_RND EQU 4 + 134 = 0004 C MD_FIL EQU 4 + 135 = 0008 C MD_APP EQU 8 + 136 = 0010 C MD_KIL EQU 16 + 137 = 0020 C MD_IBM EQU 32 + 138 = 0040 C MD_USR EQU 64 + 139 = 0080 C MD_BIN EQU 128 + 140 C + 141 C + 142 C ; Operating System dependent field sizes + 143 C + 144 = 001A C EOFCHR= 'Z' and 1fh + 145 C + 146 = 0026 C FILNAML= 38 ;Length of $FILNAM + 147 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) + 148 C + 149 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs + 150 = 0080 C REC_LENGTH= 128 ;128 byte sectors + 151 C + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-6 + + + + 152 C PAGE + 153 C + 154 C ;----- Basic Interpreter style File Data Block ----- + 155 C + 156 C ; Link block offsets + 157 C + 158 = FFFA C BL_SIZE= -6 ;Link block size (2 bytes of misc) + 159 = FFFB C FB_NUM= -5 ; File number + 160 = FFFC C BL_LEN= -4 ;Block size + 161 = FFFE C BL_LNK= -2 ;Block link + 162 C + 163 C ; File Data Block offsets + 164 C + 165 C FILE_DATA_BLOCK STRUC + 166 C + 167 0000 ?? C FD_MODE DB ? ;File mode of open + 168 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area + 169 ?? C + 170 ] C + 171 C + 172 0027 ???? C FD_CURLOC DW ? ;Current record number + 173 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector + 174 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer + 175 002B 03 [ C DB 3 DUP (?) ;Unused + 176 ?? C + 177 ] C + 178 C + 179 002E ?? C FD_DEVICE DB ? ;Device number + 180 002F ?? C FD_WIDTH DB ? ;File width + 181 0030 ?? C FD_POS DB ? ;Current file position + 182 0031 ?? C FD_FLAGS DB ? ;Used for load and save + 183 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion + 184 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer + 185 ?? C + 186 ] C + 187 C + 188 C + 189 C ; 5.0 Variable Record Information + 190 C + 191 00B3 ???? C FR_VRECL DW ? ;Variable record length + 192 00B5 ???? C FR_PHYREC DW ? ;Current physical record number + 193 00B7 ???? C FR_LOGREC DW ? ;Current logical record number + 194 00B9 ?? C DB ? ;Future use + 195 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O + 196 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer + 197 ?? C + 198 ] C + 199 C + 200 C + 201 00BD C FILE_DATA_BLOCK ENDS + 202 C + 203 C + 204 C ; End of DEVDEF.INC + 205 + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-7 + + + + 206 + 207 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 208 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 1-8 + + + + 209 PAGE + 210 + 211 ; External Data Variables + 212 + 213 EXTRN $PTRFIL:WORD, $FILPT:WORD + 214 EXTRN $$SPSV:WORD + 215 + 216 + 217 ; Local Data Definitions + 218 + 219 0000 ???? DISPATCH_ADDR DW ? ;Dispatch address + 220 + 221 + 222 ; Public Data Variables + 223 + 224 PUBLIC $FILNAM,$FILNM2,$FILMOD + 225 + 226 0002 26 [ $FILNAM DB FILNAML DUP (?) ;1st File name buffer + 227 ?? + 228 ] + 229 + 230 0028 26 [ $FILNM2 DB FILNAML DUP (?) ;2nd File name buffer + 231 ?? + 232 ] + 233 + 234 004E ?? $FILMOD DB ? ;File mode from OPEN statement + 235 + 236 004F DATA ENDS + 237 + 238 + 239 DC GROUP DATA + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 2-1 + + + + 240 + 241 + 242 0000 CODE SEGMENT WORD PUBLIC 'CODE' + 243 + 244 ASSUME CS:CODE, DS:DC, ES:DC + 245 + 246 ; Compiler generated entries + 247 + 248 PUBLIC $EOF,$LOC,$LOF ;$POF + 249 PUBLIC $DKC,$WDF,$DKN,$DKM,$DKO,$DCA + 250 PUBLIC $GET,$RGT,$PUT,$RPT,$VPT + 251 PUBLIC $WDD + 252 + 253 ; Run-time entries + 254 + 255 PUBLIC $INIDEV,$CLSDEV + 256 PUBLIC $BAKCHR,$GETCHR,$PUTCHR,$GETPOS,$GETWID + 257 PUBLIC $$BCH,$$RCH,$$WCH,$$POS,$$WID + 258 PUBLIC $SCANF,$CLOSF,$FRCSQO,$DEVOPN + 259 PUBLIC $DEVICE_TABLE + 260 + 261 ; Run-time externals + 262 + 263 EXTRN $$DITS:NEAR + 264 EXTRN $ERC_BFM:NEAR + 265 EXTRN $ERC_BFN:NEAR + 266 EXTRN $ERC_DNA:NEAR + 267 EXTRN $ERC_FAO:NEAR + 268 EXTRN $ERC_IFN:NEAR + 269 + 270 EXTRN $FBLOC:NEAR, $FBALC:NEAR, $FBDEA:NEAR + 271 EXTRN $SAVREG:NEAR + 272 + 273 EXTRN $TTY_BAKC:NEAR + 274 EXTRN $TTY_SINP:NEAR + 275 EXTRN $TTY_SOUT:NEAR + 276 EXTRN $TTY_GPOS:NEAR + 277 EXTRN $TTY_GWID:NEAR + 278 + 279 ; Device Name Generator + 280 + 281 DEVMAC MACRO ARG + 282 DB '&ARG' + 283 DB DN_&ARG + 284 ENDM + 285 + 286 0000 DEVICE_NAME_TABLE LABEL BYTE + 287 DEVNAM + 288 0000 4B 59 42 44 + DB 'KYBD' + 289 0004 FF + DB DN_KYBD + 290 0005 53 43 52 4E + DB 'SCRN' + 291 0009 FE + DB DN_SCRN + 292 000A 4C 50 54 31 + DB 'LPT1' + 293 000E FD + DB DN_LPT1 + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 2-2 + + + + 294 000F 00 DB 0 + 295 + 296 + 297 ; Device Dispatch Address Generator + 298 + 299 DEVMAC MACRO ARG + 300 EXTRN $D_&ARG:NEAR + 301 DW $D_&ARG + 302 ENDM + 303 + 304 EVEN ;Word align + 305 + 306 0010 $DEVICE_TABLE LABEL WORD + 307 + 308 DEVMAC DISK ;Disks are treated as device type 0 + 309 0010 0000 E + DW $D_DISK + 310 DEVNAM ;Rest of devices + 311 0012 0000 E + DW $D_KYBD + 312 0014 0000 E + DW $D_SCRN + 313 0016 0000 E + DW $D_LPT1 + 314 + 315 + 316 ; Device initialization dispatch address generator + 317 + 318 DEVMAC MACRO ARG + 319 EXTRN $I_&ARG:NEAR + 320 DW $I_&ARG + 321 ENDM + 322 + 323 0018 INIDEV_TABLE LABEL WORD + 324 + 325 DEVNAM ;Device initialization addresses + 326 0018 0000 E + DW $I_KYBD + 327 001A 0000 E + DW $I_SCRN + 328 001C 0000 E + DW $I_LPT1 + 329 + 330 001E INIDEV_END LABEL WORD ;End of table + 331 + 332 + 333 ; Device close dispatch address generator + 334 + 335 DEVMAC MACRO ARG + 336 EXTRN $C_&ARG:NEAR + 337 DW $C_&ARG + 338 ENDM + 339 + 340 001E CLSDEV_TABLE LABEL WORD + 341 + 342 DEVNAM ;Device close addresses + 343 001E 0000 E + DW $C_KYBD + 344 0020 0000 E + DW $C_SCRN + 345 0022 0000 E + DW $C_LPT1 + 346 + 347 0024 CLSDEV_END LABEL WORD ;End of table + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 2-3 + + + + 348 + 349 + 350 ; Device width set dispatch address generator + 351 ; + 352 ; Routine calling sequence: + 353 ; + 354 ; Entry (DX) = width + 355 + 356 DEVMAC MACRO ARG + 357 EXTRN $W_&ARG:NEAR + 358 DW $W_&ARG + 359 ENDM + 360 + 361 0024 WIDTH_TABLE LABEL WORD + 362 + 363 DEVNAM ;Width set addresses + 364 0024 0000 E + DW $W_KYBD + 365 0026 0000 E + DW $W_SCRN + 366 0028 0000 E + DW $W_LPT1 + 367 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 3-1 + + + + 368 + 369 + 370 SUBTTL Compiler Generated Entry Points + 371 + 372 + 373 ;** WIDTH "device" Statement + 374 ; + 375 ; ENTRY (BX) = device name string + 376 ; (DX) = width + 377 + 378 002A E8 0000 E $WDD: CALL $SAVREG + 379 002D 8B 0F MOV CX,[BX] ;(CX) = length + 380 002F 8B 77 02 MOV SI,[BX+2] ;(SI) = address + 381 0032 E8 0250 R CALL PARSE_DEVICE ;(AL) = device + 382 0035 0A C0 OR AL,AL ;Test for no device + 383 0037 75 03 JNZ wdd1 + 384 0039 E9 0000 E JMP $ERC_BFN ;Error - bad file name + 385 003C E8 0000 E wdd1: CALL $$DITS ;Delete if temporary string + 386 003F F6 D0 NOT AL ;Convert to 0 and up + 387 0041 98 CBW + 388 0042 D1 E0 SAL AX,1 ;2 * (NOT device#) + 389 0044 97 XCHG AX,DI ;(DI) = offset + 390 0045 2E: FF A5 0024 R JMP CS:WIDTH_TABLE[DI] ;Call width set routine - (DX) = width + 391 + 392 + 393 004A Entries PROC FAR + 394 + 395 ;** VARPTR() Functoin + 396 ; + 397 ; ENTRY (BX) = file number + 398 ; EXIT (BX) = address of file data block + 399 ; USES BX + 400 + 401 004A 89 26 0000 E $VPT: MOV [$$SPSV],SP + 402 004E 56 PUSH SI + 403 004F E8 0000 E CALL $FBLOC ;Find file block + 404 0052 75 03 JNZ vpt1 + 405 0054 E9 0138 R JMP ercifn ;Error - illegal file number + 406 0057 8B DE vpt1: MOV BX,SI ;Put address in (BX) + 407 0059 5E POP SI + 408 005A CB RET + 409 + 410 + 411 + 412 ;** EOF() Function + 413 ; + 414 ; ENTRY (BX) = file number + 415 ; EXIT (BX) = 0 or -1 if end of file + 416 ; USES BX + 417 + 418 005B 50 $EOF: PUSH AX + 419 005C B4 00 MOV AH,DV_EOF ;End of file function + 420 + 421 005E 89 26 0000 E comdsp: MOV [$$SPSV],SP + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 3-2 +Compiler Generated Entry Points + + + 422 0062 83 06 0000 E 02 ADD [$$SPSV],2 ;Current stack + 2 for PUSH AX + 423 + 424 0067 E8 01AA R comds1: CALL FILE_DISPATCH + 425 006A 58 POP AX + 426 006B CB RET + 427 + 428 + 429 + 430 ;** LOC() Function + 431 ; + 432 ; ENTRY (BX) = file number + 433 ; EXIT (BX) = current record number + 434 ; USES BX + 435 + 436 006C 50 $LOC: PUSH AX + 437 006D B4 02 MOV AH,DV_LOC ;LOC function + 438 006F EB ED JMP comdsp + 439 + 440 + 441 + 442 ;** LOF() Function + 443 ; + 444 ; ENTRY (BX) = file number + 445 ; EXIT (FAC) = length of file in bytes + 446 ; USES FAC + 447 + 448 0071 50 $LOF: PUSH AX + 449 0072 B4 04 MOV AH,DV_LOF ;LOF Function + 450 0074 EB E8 JMP comdsp + 451 + 452 + 453 + 454 ;** POS() Function #### not implemented #### + 455 ; + 456 ; ENTRY (BX) = file number + 457 ; EXIT (BX) = current position in sequential record + 458 ; USES BX + 459 + 460 ;$POF: PUSH AX + 461 ; MOV AH,DV_POS ;POS Function + 462 ; JMP comdsp + 463 + 464 + 465 + 466 ;** CLOSE statement + 467 ; + 468 ; ENTRY (BX) = file number + 469 ; USES NONE + 470 + 471 0076 89 26 0000 E $DKC: MOV [$$SPSV],SP + 472 + 473 007A 56 dkc1: PUSH SI + 474 007B E8 0000 E CALL $FBLOC ;Must check if file has been opened + 475 007E 5E POP SI + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 3-3 +Compiler Generated Entry Points + + + 476 007F 74 0C JZ dkcret ; No - just return + 477 0081 50 PUSH AX + 478 0082 B4 06 MOV AH,DV_CLOSE + 479 0084 EB E1 JMP comds1 + 480 + 481 + 482 0086 89 26 0000 E $DCA: MOV [$$SPSV],SP + 483 008A E8 01F1 R CALL $CLOSF ;Close all files + 484 008D CB dkcret: RET + 485 + 486 + 487 + 488 ;** WIDTH #fnum,width + 489 ; + 490 ; ENTRY (BX) = file number + 491 ; (DX) = width + 492 ; USES NONE + 493 + 494 008E 50 $WDF: PUSH AX + 495 008F B4 08 MOV AH,DV_WIDTH ;File width function + 496 0091 EB CB JMP comdsp + 497 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 3-4 +Compiler Generated Entry Points + + + 498 PAGE + 499 + 500 ;** $GET/$RGT/$PUT/$RPT - Random disk I/O + 501 ; + 502 ; ENTRY (BX) = file number + 503 ; (DX) = record number for relative calls + 504 ; USES AH + 505 + 506 = 0001 PUTFLG EQU 1 ;PUT call + 507 = 0002 RELFLG EQU 2 ;Record number in (DX) + 508 + 509 0093 50 $GET: PUSH AX + 510 0094 B0 00 MOV AL,0 + 511 + 512 0096 B4 0A rnddsp: MOV AH,DV_RANDIO + 513 0098 89 26 0000 E MOV [$$SPSV],SP + 514 009C 83 06 0000 E 02 ADD [$$SPSV],2 + 515 00A1 56 PUSH SI + 516 00A2 E8 0000 E CALL $FBLOC + 517 00A5 74 52 JZ ercbfm ;This is garbage - inconsistent + 518 00A7 80 3C 04 CMP [SI].FD_MODE,MD_RND + 519 00AA 75 4D JNE ercbfm ;Not random - bad file mode + 520 00AC E8 01BA R CALL PTRFIL_DISPATCH + 521 00AF 5E POP SI + 522 00B0 58 POP AX + 523 00B1 CB RET + 524 + 525 00B2 50 $RGT: PUSH AX + 526 00B3 B0 02 MOV AL,RELFLG + 527 00B5 EB DF JMP rnddsp + 528 + 529 00B7 50 $PUT: PUSH AX + 530 00B8 B0 01 MOV AL,PUTFLG + 531 00BA EB DA JMP rnddsp + 532 + 533 00BC 50 $RPT: PUSH AX + 534 00BD B0 03 MOV AL,PUTFLG+RELFLG + 535 00BF EB D5 JMP rnddsp + 536 + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 3-5 +Compiler Generated Entry Points + + + 537 PAGE + 538 + 539 ;** $DKN/$DKO/$DKM - OPEN statement + 540 ; + 541 ; The OPEN statement generates one of two preambles depending upon + 542 ; the form + 543 + 544 + 545 ;** $DKN - Standard form of OPEN + 546 ; + 547 ; ENTRY (BX) = mode sdesc + 548 ; EXIT NONE + 549 ; USES NONE + 550 + 551 00C1 89 26 0000 E $DKN: MOV [$$SPSV],SP + 552 00C5 50 PUSH AX + 553 00C6 53 PUSH BX + 554 00C7 83 3F 00 CMP WORD PTR [BX],0 ;Test for empty string + 555 00CA 74 2D JE ercbfm + 556 00CC 8B 5F 02 MOV BX,[BX+2] ;(BX) = address of string + 557 00CF 8A 1F MOV BL,[BX] ;(BL) = first character + 558 00D1 80 E3 DF AND BL,-1-' ' ;Force to upper case + 559 + 560 00D4 B0 01 MOV AL,MD_SQI ;Assume input + 561 00D6 80 FB 49 CMP BL,'I' + 562 00D9 74 15 JE havmod + 563 + 564 00DB B0 02 MOV AL,MD_SQO ;Assume output + 565 00DD 80 FB 4F CMP BL,'O' + 566 00E0 74 0E JE havmod + 567 + 568 00E2 B0 04 MOV AL,MD_FIL ;Assume random + 569 00E4 80 FB 52 CMP BL,'R' + 570 00E7 74 07 JE havmod + 571 + 572 00E9 B0 08 MOV AL,MD_APP ;Assume append + 573 00EB 80 FB 41 CMP BL,'A' + 574 00EE 75 09 JNE ercbfm ;error + 575 + 576 00F0 A2 004E R havmod: MOV [$FILMOD],AL ;Save mode for $DKM call + 577 00F3 5B POP BX + 578 00F4 E8 0000 E CALL $$DITS ;Delete temp string + 579 00F7 58 POP AX + 580 00F8 CB RET + 581 + 582 00F9 E9 0000 E ercbfm: JMP $ERC_BFM ;Error - Bad file mode + 583 + 584 + 585 ;** $DKO - SPCDSX form of OPEN statement + 586 ; + 587 ; ENTRY (BX) = file mode + 588 ; USES NONE + 589 + 590 00FC 51 $DKO: PUSH CX + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 3-6 +Compiler Generated Entry Points + + + 591 00FD 53 PUSH BX + 592 00FE 8A CB MOV CL,BL ;(CL) = shift count + 593 0100 B3 01 MOV BL,1 ;Shifting 1 + 594 0102 D2 E3 SAL BL,CL ; (CL) bits + 595 0104 88 1E 004E R MOV [$FILMOD],BL ;Save mode for $DKM call + 596 0108 5B POP BX + 597 0109 59 POP CX + 598 010A CB RET + 599 + 600 + 601 + 602 ;** $DKM - OPEN statement processor + 603 ; + 604 ; ENTRY (BX) = file number + 605 ; (DX) = file name sdesc + 606 ; (CX) = variable record length + 607 ; USES NONE + 608 + 609 010B 89 26 0000 E $DKM: MOV [$$SPSV],SP + 610 010F 50 PUSH AX + 611 0110 56 PUSH SI + 612 + 613 0111 51 PUSH CX + 614 0112 52 PUSH DX + 615 0113 53 PUSH BX + 616 0114 8B DA MOV BX,DX ;(BX) = file name sdesc + 617 0116 8B 0F MOV CX,[BX] ;(CX) = file name length + 618 0118 8B 77 02 MOV SI,[BX+2] ;(SI) = file name contents + 619 011B E8 020A R CALL $SCANF ;(AL) = device # + 620 011E E8 0000 E CALL $$DITS ;Delete temp string + 621 0121 5B POP BX + 622 0122 5A POP DX + 623 0123 59 POP CX + 624 + 625 0124 0B DB OR BX,BX ;Test for 0 and neg + 626 0126 76 10 JBE ercifn + 627 0128 E8 0000 E CALL $FBLOC ;Check if file open + 628 012B 75 08 JNZ ercfao ; Already open + 629 + 630 012D B4 0C MOV AH,DV_OPEN + 631 012F E8 01B5 R CALL OPEN_DISPATCH ;Dispatch + 632 + 633 0132 5E POP SI + 634 0133 58 POP AX + 635 0134 CB RET + 636 + 637 0135 E9 0000 E ercfao: JMP $ERC_FAO ;Error - File already open + 638 + 639 0138 E9 0000 E ercifn: JMP $ERC_IFN ;Error - Illegal file number + 640 + 641 + 642 013B Entries ENDP + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-1 +Compiler Generated Entry Points + + + 643 + 644 + 645 SUBTTL Runtime Internal routines + 646 + 647 013B Locals PROC NEAR + 648 + 649 ;----- Device Dispatch Routines ----------------------------------------- + 650 + 651 + 652 ;** $INIDEV - Device initialization dispatcher + 653 ; + 654 ; This routine calls initialization routines for each device + 655 ; in the device table. + 656 + 657 013B $INIDEV: + 658 013B BB 0016 R MOV BX,OFFSET INIDEV_TABLE-2 ;Adjust for no disk entry + 659 + 660 013E BF 0006 devsub: MOV DI,LAST_DEVICE_OFFSET-2 ;Use actual offset of last device + 661 + 662 0141 53 devlp: PUSH BX + 663 0142 57 PUSH DI + 664 0143 2E: FF 11 CALL WORD PTR CS:[BX+DI] ;Dispatch to device routine + 665 0146 5F POP DI + 666 0147 5B POP BX + 667 0148 4F DEC DI + 668 0149 4F DEC DI + 669 014A 75 F5 JNZ devlp ;Loop until device offset = 0 + 670 014C C3 RET + 671 + 672 + 673 + 674 ;** $CLSDEV - Device close dispatcher + 675 ; + 676 ; This routine calls close routines for each device + 677 ; in the device table. + 678 + 679 014D $CLSDEV: + 680 014D BB 001C R MOV BX,OFFSET CLSDEV_TABLE-2 ;Adjust for no disk entry + 681 0150 EB EC JMP devsub + 682 + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-2 +Runtime Internal routines + + + 683 PAGE + 684 ;_____ File Dispatch Routines ------------------------------------------ + 685 + 686 + 687 ;** $BAKCHR - Backup character in (AL) + 688 ; + 689 ; ENTRY (AL) = character to backup + 690 ; $PTRFIL = file data block pointer + 691 ; USES AH + 692 + 693 0152 $$BCH: + 694 0152 $BAKCHR: + 695 0152 56 PUSH SI + 696 0153 8B 36 0000 E MOV SI,$PTRFIL + 697 0157 0B F6 OR SI,SI + 698 0159 75 04 JNZ bakch1 + 699 + 700 015B 5E POP SI + 701 015C E9 0000 E JMP $TTY_BAKC ;Console backup + 702 + 703 015F B4 0E bakch1: MOV AH,DV_BAKC + 704 + 705 0161 E8 01BA R ptrdsp: CALL PTRFIL_DISPATCH + 706 0164 5E POP SI + 707 0165 C3 RET + 708 + 709 + 710 + 711 ;** $GETCHR - Input character into (AL) + 712 ; + 713 ; ENTRY none + 714 ; EXIT (AL) = character + 715 + 716 0166 $$RCH: + 717 0166 $GETCHR: + 718 0166 56 PUSH SI + 719 0167 8B 36 0000 E MOV SI,$PTRFIL + 720 016B 0B F6 OR SI,SI + 721 016D 75 04 JNZ getch1 + 722 + 723 016F 5E POP SI + 724 0170 E9 0000 E JMP $TTY_SINP ;Console input + 725 + 726 0173 B4 10 getch1: MOV AH,DV_SINP + 727 0175 EB EA JMP ptrdsp + 728 + 729 + 730 + 731 ;** $PUTCHR - Output character in (AL) + 732 ; + 733 ; ENTRY (AL) = character to output + 734 ; EXIT none + 735 ; USES AH + 736 + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-3 +Runtime Internal routines + + + 737 0177 $$WCH: + 738 0177 $PUTCHR: + 739 0177 56 PUSH SI + 740 0178 8B 36 0000 E MOV SI,$PTRFIL + 741 017C 0B F6 OR SI,SI + 742 017E 75 04 JNZ putch1 + 743 + 744 0180 5E POP SI + 745 0181 E9 0000 E JMP $TTY_SOUT ;Console output + 746 + 747 0184 B4 12 putch1: MOV AH,DV_SOUT + 748 0186 EB D9 JMP ptrdsp + 749 + 750 + 751 + 752 ;** $GETPOS - Get current file position + 753 ; + 754 ; EXIT (AH) = file position + 755 + 756 0188 $$POS: + 757 0188 $GETPOS: + 758 0188 56 PUSH SI + 759 0189 8B 36 0000 E MOV SI,[$PTRFIL] + 760 018D 0B F6 OR SI,SI + 761 018F 75 04 JNZ getps1 + 762 + 763 0191 5E POP SI + 764 0192 E9 0000 E JMP $TTY_GPOS ;Get TTY position + 765 + 766 0195 B4 14 getps1: MOV AH,DV_GPOS ;Get position + 767 0197 EB C8 JMP ptrdsp + 768 + 769 + 770 + 771 ;** $GETWID - Get current file width + 772 ; + 773 ; EXIT (AH) = file width + 774 + 775 0199 $$WID: + 776 0199 $GETWID: + 777 0199 56 PUSH SI + 778 019A 8B 36 0000 E MOV SI,[$PTRFIL] + 779 019E 0B F6 OR SI,SI + 780 01A0 75 04 JNZ getwd1 + 781 + 782 01A2 5E POP SI + 783 01A3 E9 0000 E JMP $TTY_GWID + 784 + 785 01A6 B4 16 getwd1: MOV AH,DV_GWID + 786 01A8 EB B7 JMP ptrdsp + 787 + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-4 +Runtime Internal routines + + + 788 PAGE + 789 + 790 ;** FILE_DISPATCH - File number to device dispatcher + 791 ; + 792 ;** PTRFIL_DISPATCH - PTRFIL to device dispatcher + 793 ; + 794 ;** OPEN_DISPATCH - OPEN file device dispatcher + 795 ; + 796 ; The following information is passed to the routine: + 797 ; + 798 ; (AL,CX,DX,BX) = parameters + 799 ; (SI) = file block pointer + 800 ; (DI) = device offset + 801 ; + 802 ; Both the (SI) and (DI) registers can be used as temporaries since + 803 ; they are not needed upon return. + 804 ; + 805 ; FILE_DISPATCH and OPEN_DISPATCH + 806 ; + 807 ; ENTRY (BX) = file number + 808 ; (AL) = device number for OPEN_DISPATCH + 809 ; (AH) = function to dispatch on + 810 ; (AL,CX,DX) = other parameters + 811 ; USES AH,F + 812 ; + 813 ; PTRFIL_DISPATCH + 814 ; + 815 ; ENTRY (AL) = character + 816 ; (SI) = FDB pointer + 817 ; EXIT (AL) = character + 818 ; USES AX,F + 819 + 820 01AA FILE_DISPATCH: + 821 01AA 56 PUSH SI + 822 01AB E8 0000 E CALL $FBLOC ;(SI) = file data block pointer + 823 01AE 74 88 JZ ercifn ;Error - illegal file number + 824 01B0 E8 01BA R CALL PTRFIL_DISPATCH + 825 01B3 5E POP SI + 826 01B4 C3 RET + 827 + 828 01B5 OPEN_DISPATCH: + 829 01B5 57 PUSH DI + 830 01B6 53 PUSH BX + 831 01B7 50 PUSH AX + 832 01B8 EB 06 JMP SHORT opndsp + 833 + 834 01BA PTRFIL_DISPATCH: ;(SI) = file data block pointer + 835 01BA 57 PUSH DI + 836 01BB 53 PUSH BX + 837 01BC 50 PUSH AX + 838 + 839 01BD 8A 44 2E MOV AL,[SI].FD_DEVICE ;(AL) = device number + 840 01C0 0A C0 opndsp: OR AL,AL + 841 01C2 78 04 JS getdv1 ;must be a special device + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-5 +Runtime Internal routines + + + 842 01C4 32 C0 XOR AL,AL ;(AL) = 0 for disks + 843 01C6 EB 02 JMP SHORT getdv2 + 844 01C8 F6 D8 getdv1: NEG AL ;(AL) = - device number for special + 845 01CA 98 getdv2: CBW + 846 01CB D1 E0 SAL AX,1 + 847 01CD 8B F8 MOV DI,AX ;(DI) = device offset + 848 01CF 2E: 8B 9D 0010 R MOV BX,CS:$DEVICE_TABLE[DI] + 849 01D4 0B DB OR BX,BX ;If entry is 0, then unavailable + 850 01D6 74 16 JZ ercdna ; Error + 851 01D8 58 POP AX ;(AH) = function code + 852 01D9 50 PUSH AX + 853 01DA 86 E0 XCHG AH,AL + 854 01DC 98 CBW + 855 01DD 03 D8 ADD BX,AX ;Add function code offset to dispatch + 856 01DF 2E: 8B 1F MOV BX,CS:[BX] ;Get address of routine + 857 01E2 89 1E 0000 R MOV [DISPATCH_ADDR],BX ;Save it for indirect call + 858 01E6 58 POP AX ;Restore (AL) + 859 01E7 5B POP BX ;Restore (BX) + 860 01E8 FF 16 0000 R CALL [DISPATCH_ADDR] ;Execute routine + 861 01EC 5F POP DI + 862 01ED C3 RET + 863 + 864 01EE E9 0000 E ercdna: JMP $ERC_DNA + 865 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-6 +Runtime Internal routines + + + 866 PAGE + 867 + 868 ;** $CLOSF - Close all files + 869 ; + 870 ; ENTRY NONE + 871 ; EXIT NONE + 872 ; USES NONE + 873 + 874 01F1 $CLOSF: + 875 01F1 53 PUSH BX + 876 01F2 56 PUSH SI + 877 + 878 01F3 8B 36 0000 E closf1: MOV SI,[$FILPT] ;Get address of next file block + 879 01F7 0B F6 OR SI,SI + 880 01F9 74 0C JZ closf3 ;Finished + 881 + 882 01FB 8A 5C FB MOV BL,[SI].FB_NUM ;Get file # + 883 01FE 32 FF XOR BH,BH + 884 0200 9A 007A ---- R CALL FAR PTR dkc1 ;Close file in (BX) + 885 0205 EB EC JMP closf1 ;Keep looping + 886 + 887 0207 5E closf3: POP SI + 888 0208 5B POP BX + 889 0209 C3 RET + 890 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-7 +Runtime Internal routines + + + 891 PAGE + 892 + 893 ;** $SCANF - Scan file name + 894 ; + 895 ; ENTRY (SI) = text pointer + 896 ; (CX) = length + 897 ; EXIT (AL) = device # + 898 ; FILNAM = (device # , filename.ext) + 899 ; USES CX,SI + 900 + 901 020A $SCANF: + 902 020A E8 0250 R CALL PARSE_DEVICE ;(AL) = device # + 903 020D A2 0002 R MOV [$FILNAM],AL ;Save device # + 904 0210 0A C0 OR AL,AL + 905 0212 78 02 JS _030 + 906 0214 32 C0 XOR AL,AL ;(AL) = 0 for disks + 907 0216 50 _030: PUSH AX + 908 0217 52 PUSH DX + 909 0218 57 PUSH DI + 910 0219 BF 0003 R MOV DI,OFFSET DC:$FILNAM+1 + 911 021C BA 000B MOV DX,FILNAM_LENGTH + 912 + 913 + 914 021F E3 27 scan1: JCXZ filspc ;End of string + 915 0221 49 DEC CX + 916 0222 AC LODSB ;Get character + 917 0223 3C 20 CMP AL,' ' + 918 0225 73 03 JAE _040 + 919 + 920 0227 E9 0000 E ercbfn: JMP $ERC_BFN + 921 + 922 022A 3C 2E _040: CMP AL,'.' + 923 022C 74 08 JE fillnm + 924 022E AA STOSB ;Store character + 925 022F 4A DEC DX + 926 0230 75 ED JNZ scan1 ;Keep looking for characters + 927 + 928 0232 5F gotnam: POP DI + 929 0233 5A POP DX + 930 0234 58 POP AX + 931 0235 C3 RET + 932 + 933 0236 83 FA 0B fillnm: CMP DX,FILNAM_LENGTH + 934 0239 74 EC JE ercbfn ;Error - extension only ! + 935 023B 83 FA 03 CMP DX,3 + 936 023E 72 E7 JB ercbfn ;Error - 2nd dot + 937 0240 74 DD JE scan1 ;Scan extension like filename + 938 0242 B0 20 MOV AL,' ' + 939 0244 AA STOSB ;Fill with blank + 940 0245 4A DEC DX + 941 0246 EB EE JMP fillnm ;Keep filling + 942 + 943 0248 B0 20 filspc: MOV AL,' ' ;Fill short name with spaces + 944 024A AA STOSB + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-8 +Runtime Internal routines + + + 945 024B 4A DEC DX + 946 024C 75 FA JNZ filspc ;Keep filling + 947 024E EB E2 JMP gotnam ;Done with name + 948 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-9 +Runtime Internal routines + + + 949 PAGE + 950 + 951 ;** PARSE_DEVICE - Parse device name from string + 952 ; + 953 ; ENTRY (CX) = length of string + 954 ; (SI) = string address + 955 ; EXIT (AL) = device # (0 = default , - = special) + 956 ; (CX) = remaining count + 957 ; (SI) = address of remaining string + 958 + 959 0250 PARSE_DEVICE: + 960 0250 52 PUSH DX + 961 0251 57 PUSH DI + 962 0252 56 PUSH SI + 963 0253 8B D1 MOV DX,CX ;(DX) = original length + 964 0255 E3 07 JCXZ nodvnm ;If length = 0 , no device name + 965 + 966 0257 AC devscn: LODSB ;Get character + 967 0258 3C 3A CMP AL,':' + 968 025A 74 0A JE devnm ;Found possible name + 969 025C E2 F9 LOOP devscn + 970 + 971 025E 8B CA nodvnm: MOV CX,DX ;No device name - restore everything + 972 0260 5E POP SI + 973 0261 5F POP DI + 974 0262 5A POP DX + 975 0263 32 C0 XOR AL,AL ;Default device to 0 + 976 0265 C3 RET + 977 + 978 0266 5F devnm: POP DI ;Restore old string pointer + 979 0267 87 F7 XCHG SI,DI + 980 0269 57 PUSH DI ;Save new string pointer + 981 026A 2B D1 SUB DX,CX ;(DX) = device name length + 982 026C 74 B9 JZ ercbfn ;Length = 0 - bad file name + 983 026E 49 DEC CX ;Count off : + 984 026F 83 FA 01 CMP DX,1 + 985 0272 74 39 JE dsknam ;Length = 1 - must be disk name + 986 + 987 0274 BF FFFF R MOV DI,OFFSET DEVICE_NAME_TABLE-1 + 988 0277 56 devsrc: PUSH SI + 989 0278 52 PUSH DX + 990 + 991 0279 47 devlop: INC DI + 992 027A AC LODSB + 993 027B E8 02BB R CALL UPCASE ;Convert to upper case + 994 027E 2E: F6 05 80 TEST BYTE PTR CS:[DI],80H ;Check to see if at device (long name) + 995 0282 75 1D JNZ nmtch2 + 996 0284 2E: 38 05 CMP CS:[DI],AL + 997 0287 75 12 JNE nomtch + 998 0289 4A DEC DX + 999 028A 75 ED JNZ devlop + 1000 + 1001 028C 47 fnddev: INC DI + 1002 028D 2E: 8A 05 MOV AL,CS:[DI] ;Get device # + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-10 +Runtime Internal routines + + + 1003 0290 0A C0 OR AL,AL + 1004 0292 79 07 JNS nomtch ;Not a device # + 1005 + 1006 0294 5E POP SI + 1007 0295 5E POP SI + 1008 0296 5E devret: POP SI ;(SI) = pointer after : + 1009 0297 5F POP DI + 1010 0298 5A POP DX + 1011 0299 C3 RET ;(CX) = chars left , (AL) = device # + 1012 + 1013 029A 47 nmtch1: INC DI + 1014 029B 2E: F6 05 80 NOMTCH: TEST BYTE PTR CS:[DI],80H ;Check for device # + 1015 029F 74 F9 JZ nmtch1 ; No + 1016 02A1 5A nmtch2: POP DX + 1017 02A2 5E POP SI + 1018 02A3 2E: 80 7D 01 00 CMP BYTE PTR CS:[DI+1],0 ;End of table? + 1019 02A8 75 CD JNE devsrc ; No - check next entry + 1020 + 1021 02AA E9 0227 R _050: JMP ercbfn ;Error - bad filename (device name) + 1022 + 1023 02AD AC dsknam: LODSB ;Refetch character + 1024 02AE E8 02BB R CALL UPCASE + 1025 02B1 2C 40 SUB AL,'A'-1 ;Convert letter to 1-26 (let @ be 0) + 1026 02B3 72 F5 JC _050 ; Less than @ + 1027 02B5 3C 1A CMP AL,'Z' and 01FH + 1028 02B7 73 F1 JNC _050 ; Greater than Z + 1029 02B9 EB DB JMP devret + 1030 + 1031 02BB 3C 61 UPCASE: CMP AL,'a' ;Convert (AL) to upper case + 1032 02BD 72 06 JB upret + 1033 02BF 3C 7A CMP AL,'z' + 1034 02C1 77 02 JA upret + 1035 02C3 24 DF AND AL,255-' ' + 1036 02C5 C3 upret: RET + 1037 + + + + + + + + + + + + + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Page 4-11 +Runtime Internal routines + + + 1038 PAGE + 1039 + 1040 ;** $FRCSQO - Force MD_RND to MD_SQO + 1041 + 1042 02C6 $FRCSQO: + 1043 02C6 80 3E 004E R 04 CMP [$FILMOD],MD_RND + 1044 02CB 75 05 JNE frcret + 1045 02CD C6 06 004E R 02 MOV [$FILMOD],MD_SQO + 1046 02D2 C3 frcret: RET + 1047 + 1048 + 1049 + 1050 ;** $DEVOPN - Special device open common routine + 1051 ; + 1052 ; ENTRY (AL) = file device + 1053 ; (AH) = valid file modes + 1054 ; (CX) = buffer size (not including basic FDB size) + 1055 ; (DL) = file width + 1056 ; (DH) = initial file position + 1057 ; (BX) = file number + 1058 ; USES CX,DI + 1059 + 1060 02D3 $DEVOPN: + 1061 02D3 84 26 004E R TEST [$FILMOD],AH ;Check for valid file mode + 1062 02D7 74 1F JZ ercbfm1 ; Bad file mode + 1063 + 1064 02D9 87 D9 XCHG BX,CX + 1065 02DB 83 C3 33 ADD BX,FD_BUFFER ;(BX) = size of block to allocate + 1066 02DE E8 0000 E CALL $FBALC ;Allocate block + 1067 02E1 87 D9 XCHG BX,CX ;(BX) = file number + 1068 02E3 8B 3E 0000 E MOV DI,[$FILPT] ;Link in new file block + 1069 02E7 89 7C FE MOV [SI].BL_LNK,DI + 1070 02EA 89 36 0000 E MOV [$FILPT],SI ; right in front + 1071 02EE 88 5C FB MOV [SI].FB_NUM,BL ;Set file number + 1072 + 1073 02F1 88 44 2E MOV [SI].FD_DEVICE,AL ;Set file device + 1074 02F4 89 54 2F MOV WORD PTR [SI].FD_WIDTH,DX ;Set file width/position + 1075 02F7 C3 RET + 1076 + 1077 02F8 E9 0000 E ercbfm1:JMP $ERC_BFM ;Bad file mode + 1078 + 1079 + 1080 02FB Locals ENDP + 1081 + 1082 02FB CODE ENDS + 1083 + 1084 END + + + + + + + + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0001 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 02FB WORD PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 004F WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BAKCH1 . . . . . . . . . . . . . L NEAR 015F CODE +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +CLOSF1 . . . . . . . . . . . . . L NEAR 01F3 CODE +CLOSF3 . . . . . . . . . . . . . L NEAR 0207 CODE +CLSDEV_END . . . . . . . . . . . L WORD 0024 CODE +CLSDEV_TABLE . . . . . . . . . . L WORD 001E CODE + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Symbols-2 + + + +COMDS1 . . . . . . . . . . . . . L NEAR 0067 CODE +COMDSP . . . . . . . . . . . . . L NEAR 005E CODE +DEVICE_NAME_TABLE. . . . . . . . L BYTE 0000 CODE +DEVLOP . . . . . . . . . . . . . L NEAR 0279 CODE +DEVLP. . . . . . . . . . . . . . L NEAR 0141 CODE +DEVNM. . . . . . . . . . . . . . L NEAR 0266 CODE +DEVRET . . . . . . . . . . . . . L NEAR 0296 CODE +DEVSCN . . . . . . . . . . . . . L NEAR 0257 CODE +DEVSRC . . . . . . . . . . . . . L NEAR 0277 CODE +DEVSUB . . . . . . . . . . . . . L NEAR 013E CODE +DISPATCH_ADDR. . . . . . . . . . L WORD 0000 DATA +DKC1 . . . . . . . . . . . . . . L NEAR 007A CODE +DKCRET . . . . . . . . . . . . . L NEAR 008D CODE +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DSKNAM . . . . . . . . . . . . . L NEAR 02AD CODE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +ENTRIES. . . . . . . . . . . . . F PROC 004A CODE Length =00F1 +EOFCHR . . . . . . . . . . . . . Number 001A +ERCBFM . . . . . . . . . . . . . L NEAR 00F9 CODE +ERCBFM1. . . . . . . . . . . . . L NEAR 02F8 CODE +ERCBFN . . . . . . . . . . . . . L NEAR 0227 CODE +ERCDNA . . . . . . . . . . . . . L NEAR 01EE CODE +ERCFAO . . . . . . . . . . . . . L NEAR 0135 CODE +ERCIFN . . . . . . . . . . . . . L NEAR 0138 CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILE_DISPATCH. . . . . . . . . . L NEAR 01AA CODE +FILLNM . . . . . . . . . . . . . L NEAR 0236 CODE +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +FILSPC . . . . . . . . . . . . . L NEAR 0248 CODE +FNDDEV . . . . . . . . . . . . . L NEAR 028C CODE +FRCRET . . . . . . . . . . . . . L NEAR 02D2 CODE +GETCH1 . . . . . . . . . . . . . L NEAR 0173 CODE +GETDV1 . . . . . . . . . . . . . L NEAR 01C8 CODE +GETDV2 . . . . . . . . . . . . . L NEAR 01CA CODE +GETPS1 . . . . . . . . . . . . . L NEAR 0195 CODE +GETWD1 . . . . . . . . . . . . . L NEAR 01A6 CODE +GOTNAM . . . . . . . . . . . . . L NEAR 0232 CODE +HAVMOD . . . . . . . . . . . . . L NEAR 00F0 CODE + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Symbols-3 + + + +INIDEV_END . . . . . . . . . . . L WORD 001E CODE +INIDEV_TABLE . . . . . . . . . . L WORD 0018 CODE +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LOCALS . . . . . . . . . . . . . N PROC 013B CODE Length =01C0 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +NMTCH1 . . . . . . . . . . . . . L NEAR 029A CODE +NMTCH2 . . . . . . . . . . . . . L NEAR 02A1 CODE +NODVNM . . . . . . . . . . . . . L NEAR 025E CODE +NOMTCH . . . . . . . . . . . . . L NEAR 029B CODE +OPEN_DISPATCH. . . . . . . . . . L NEAR 01B5 CODE +OPNDSP . . . . . . . . . . . . . L NEAR 01C0 CODE +PARSE_DEVICE . . . . . . . . . . L NEAR 0250 CODE +PTRDSP . . . . . . . . . . . . . L NEAR 0161 CODE +PTRFIL_DISPATCH. . . . . . . . . L NEAR 01BA CODE +PUTCH1 . . . . . . . . . . . . . L NEAR 0184 CODE +PUTFLG . . . . . . . . . . . . . Number 0001 +REC_LENGTH . . . . . . . . . . . Number 0080 +RELFLG . . . . . . . . . . . . . Number 0002 +RNDDSP . . . . . . . . . . . . . L NEAR 0096 CODE +SCAN1. . . . . . . . . . . . . . L NEAR 021F CODE +UPCASE . . . . . . . . . . . . . L NEAR 02BB CODE +UPRET. . . . . . . . . . . . . . L NEAR 02C5 CODE +VPT1 . . . . . . . . . . . . . . L NEAR 0057 CODE +WDD1 . . . . . . . . . . . . . . L NEAR 003C CODE +WIDTH_TABLE. . . . . . . . . . . L WORD 0024 CODE +$$BCH. . . . . . . . . . . . . . L NEAR 0152 CODE Global +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External +$$POS. . . . . . . . . . . . . . L NEAR 0188 CODE Global +$$RCH. . . . . . . . . . . . . . L NEAR 0166 CODE Global +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$WCH. . . . . . . . . . . . . . L NEAR 0177 CODE Global +$$WID. . . . . . . . . . . . . . L NEAR 0199 CODE Global +$BAKCHR. . . . . . . . . . . . . L NEAR 0152 CODE Global +$CLOSF . . . . . . . . . . . . . L NEAR 01F1 CODE Global +$CLSDEV. . . . . . . . . . . . . L NEAR 014D CODE Global +$C_KYBD. . . . . . . . . . . . . L NEAR 0000 CODE External +$C_LPT1. . . . . . . . . . . . . L NEAR 0000 CODE External +$C_SCRN. . . . . . . . . . . . . L NEAR 0000 CODE External +$DCA . . . . . . . . . . . . . . L NEAR 0086 CODE Global +$DEVICE_TABLE. . . . . . . . . . L WORD 0010 CODE Global +$DEVOPN. . . . . . . . . . . . . L NEAR 02D3 CODE Global +$DKC . . . . . . . . . . . . . . L NEAR 0076 CODE Global +$DKM . . . . . . . . . . . . . . L NEAR 010B CODE Global +$DKN . . . . . . . . . . . . . . L NEAR 00C1 CODE Global +$DKO . . . . . . . . . . . . . . L NEAR 00FC CODE Global +$D_DISK. . . . . . . . . . . . . L NEAR 0000 CODE External + + +IODEV - Device Independent I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:3:55 13-Nov-81 Symbols-4 + + + +$D_KYBD. . . . . . . . . . . . . L NEAR 0000 CODE External +$D_LPT1. . . . . . . . . . . . . L NEAR 0000 CODE External +$D_SCRN. . . . . . . . . . . . . L NEAR 0000 CODE External +$EOF . . . . . . . . . . . . . . L NEAR 005B CODE Global +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_BFN . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_DNA . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FAO . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IFN . . . . . . . . . . . . L NEAR 0000 CODE External +$FBALC . . . . . . . . . . . . . L NEAR 0000 CODE External +$FBDEA . . . . . . . . . . . . . L NEAR 0000 CODE External +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE External +$FILMOD. . . . . . . . . . . . . L BYTE 004E DATA Global +$FILNAM. . . . . . . . . . . . . L BYTE 0002 DATA Global Length =0026 +$FILNM2. . . . . . . . . . . . . L BYTE 0028 DATA Global Length =0026 +$FILPT . . . . . . . . . . . . . V WORD 0000 DATA External +$FRCSQO. . . . . . . . . . . . . L NEAR 02C6 CODE Global +$GET . . . . . . . . . . . . . . L NEAR 0093 CODE Global +$GETCHR. . . . . . . . . . . . . L NEAR 0166 CODE Global +$GETPOS. . . . . . . . . . . . . L NEAR 0188 CODE Global +$GETWID. . . . . . . . . . . . . L NEAR 0199 CODE Global +$INIDEV. . . . . . . . . . . . . L NEAR 013B CODE Global +$I_KYBD. . . . . . . . . . . . . L NEAR 0000 CODE External +$I_LPT1. . . . . . . . . . . . . L NEAR 0000 CODE External +$I_SCRN. . . . . . . . . . . . . L NEAR 0000 CODE External +$LOC . . . . . . . . . . . . . . L NEAR 006C CODE Global +$LOF . . . . . . . . . . . . . . L NEAR 0071 CODE Global +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +$PUT . . . . . . . . . . . . . . L NEAR 00B7 CODE Global +$PUTCHR. . . . . . . . . . . . . L NEAR 0177 CODE Global +$RGT . . . . . . . . . . . . . . L NEAR 00B2 CODE Global +$RPT . . . . . . . . . . . . . . L NEAR 00BC CODE Global +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SCANF . . . . . . . . . . . . . L NEAR 020A CODE Global +$TTY_BAKC. . . . . . . . . . . . L NEAR 0000 CODE External +$TTY_GPOS. . . . . . . . . . . . L NEAR 0000 CODE External +$TTY_GWID. . . . . . . . . . . . L NEAR 0000 CODE External +$TTY_SINP. . . . . . . . . . . . L NEAR 0000 CODE External +$TTY_SOUT. . . . . . . . . . . . L NEAR 0000 CODE External +$VPT . . . . . . . . . . . . . . L NEAR 004A CODE Global +$WDD . . . . . . . . . . . . . . L NEAR 002A CODE Global +$WDF . . . . . . . . . . . . . . L NEAR 008E CODE Global +$W_KYBD. . . . . . . . . . . . . L NEAR 0000 CODE External +$W_LPT1. . . . . . . . . . . . . L NEAR 0000 CODE External +$W_SCRN. . . . . . . . . . . . . L NEAR 0000 CODE External +_030 . . . . . . . . . . . . . . L NEAR 0216 CODE +_040 . . . . . . . . . . . . . . L NEAR 022A CODE +_050 . . . . . . . . . . . . . . L NEAR 02AA CODE +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 diff --git a/3_source_code/BASLIB-86/DEVDEF.INC b/3_source_code/BASLIB-86/DEVDEF.INC new file mode 100644 index 0000000..cbaf5bf --- /dev/null +++ b/3_source_code/BASLIB-86/DEVDEF.INC @@ -0,0 +1,131 @@ + PAGE + +; DEVDEF.INC - Device Independent I/O Definitions + + INCLUDE SYSTEM.INC + PAGE + +DEVNAM MACRO + DEVMAC KYBD + DEVMAC SCRN +if _IBM_ + DEVMAC CAS1 + DEVMAC COM1 + DEVMAC COM2 +endif + DEVMAC LPT1 +if _IBM_ + DEVMAC LPT2 + DEVMAC LPT3 +endif + ENDM + +___DEV= -1 + +DEVMAC MACRO ARG +DN_&ARG= ___DEV +.xcref +___DEV= ___DEV-1 +.cref + ENDM + + DEVNAM + +LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + PAGE + +DSPNAM MACRO + DSPMAC EOF ;EOF function + DSPMAC LOC ;LOC function + DSPMAC LOF ;LOF function +; DSPMAC POS ;POS function + DSPMAC CLOSE ;CLOSE statement + DSPMAC WIDTH ;WIDTH statement + DSPMAC RANDIO ;GET/PUT statements + DSPMAC OPEN ;OPEN statement + DSPMAC BAKC ;Backup character + DSPMAC SINP ;Serial input + DSPMAC SOUT ;Serial output + DSPMAC GPOS ;Get current position + DSPMAC GWID ;Get current width + ENDM + + +; Device Function Dispatch Table Offsets + + +DSPMAC MACRO func +ENT DV_&func,2 + ENDM + + +ENTORG 0 + DSPNAM +ENT DV_TABLEN,0 + + PAGE + +; File Mode Definitions + +MD_SQI EQU 1 +MD_SQO EQU 2 +MD_RND EQU 4 +MD_FIL EQU 4 +MD_APP EQU 8 +MD_KIL EQU 16 +MD_IBM EQU 32 +MD_USR EQU 64 +MD_BIN EQU 128 + + +; Operating System dependent field sizes + +EOFCHR= 'Z' and 1fh + +FILNAML= 38 ;Length of $FILNAM +FILNAM_LENGTH= 11 ;Actual length of name (8+3) + +FCB_LENGTH= 38 ;38 byte FCBs +REC_LENGTH= 128 ;128 byte sectors + + PAGE + +;----- Basic Interpreter style File Data Block ----- + +; Link block offsets + +BL_SIZE= -6 ;Link block size (2 bytes of misc) + FB_NUM= -5 ; File number +BL_LEN= -4 ;Block size +BL_LNK= -2 ;Block link + +; File Data Block offsets + +FILE_DATA_BLOCK STRUC + + FD_MODE DB ? ;File mode of open + FD_FCB DB FCB_LENGTH DUP (?) ;FCB area + FD_CURLOC DW ? ;Current record number + FD_ORNOFS DB ? ;Byte count in sector + FD_NMLOFS DB ? ;Bytes left in input buffer + DB 3 DUP (?) ;Unused + FD_DEVICE DB ? ;Device number + FD_WIDTH DB ? ;File width + FD_POS DB ? ;Current file position + FD_FLAGS DB ? ;Used for load and save + FD_OUTPOS DB ? ;Output position for tab expansion + FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer + +; 5.0 Variable Record Information + + FR_VRECL DW ? ;Variable record length + FR_PHYREC DW ? ;Current physical record number + FR_LOGREC DW ? ;Current logical record number + DB ? ;Future use + FR_OUTPOS DW ? ;Output position for sequential I/O + FR_FIELD DB 1 DUP (?) ;Field buffer + +FILE_DATA_BLOCK ENDS + + +; End of DEVDEF.INC diff --git a/3_source_code/BASLIB-86/IODEV.ASM b/3_source_code/BASLIB-86/IODEV.ASM new file mode 100644 index 0000000..e85732b --- /dev/null +++ b/3_source_code/BASLIB-86/IODEV.ASM @@ -0,0 +1,864 @@ + TITLE IODEV - Device Independent I/O Drivers for BASCOM-86 +PAGE 60,132 + +; This module contains the device independent I/O drivers for the +; 8086 BASIC Compiler runtime. + + + INCLUDE TABMAC.INC + INCLUDE DEVDEF.INC + + +DATA SEGMENT WORD PUBLIC 'DATA' + + PAGE + +; External Data Variables + + EXTRN $PTRFIL:WORD, $FILPT:WORD + EXTRN $$SPSV:WORD + + +; Local Data Definitions + +DISPATCH_ADDR DW ? ;Dispatch address + + +; Public Data Variables + + PUBLIC $FILNAM,$FILNM2,$FILMOD + +$FILNAM DB FILNAML DUP (?) ;1st File name buffer +$FILNM2 DB FILNAML DUP (?) ;2nd File name buffer +$FILMOD DB ? ;File mode from OPEN statement + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT WORD PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + +; Compiler generated entries + + PUBLIC $EOF,$LOC,$LOF ;$POF + PUBLIC $DKC,$WDF,$DKN,$DKM,$DKO,$DCA + PUBLIC $GET,$RGT,$PUT,$RPT,$VPT + PUBLIC $WDD + +; Run-time entries + + PUBLIC $INIDEV,$CLSDEV + PUBLIC $BAKCHR,$GETCHR,$PUTCHR,$GETPOS,$GETWID + PUBLIC $$BCH,$$RCH,$$WCH,$$POS,$$WID + PUBLIC $SCANF,$CLOSF,$FRCSQO,$DEVOPN + PUBLIC $DEVICE_TABLE + +; Run-time externals + + EXTRN $$DITS:NEAR + EXTRN $ERC_BFM:NEAR + EXTRN $ERC_BFN:NEAR + EXTRN $ERC_DNA:NEAR + EXTRN $ERC_FAO:NEAR + EXTRN $ERC_IFN:NEAR + + EXTRN $FBLOC:NEAR, $FBALC:NEAR, $FBDEA:NEAR + EXTRN $SAVREG:NEAR + + EXTRN $TTY_BAKC:NEAR + EXTRN $TTY_SINP:NEAR + EXTRN $TTY_SOUT:NEAR + EXTRN $TTY_GPOS:NEAR + EXTRN $TTY_GWID:NEAR + +; Device Name Generator + +DEVMAC MACRO ARG + DB '&ARG' + DB DN_&ARG + ENDM + +DEVICE_NAME_TABLE LABEL BYTE + DEVNAM + DB 0 + + +; Device Dispatch Address Generator + +DEVMAC MACRO ARG + EXTRN $D_&ARG:NEAR + DW $D_&ARG + ENDM + + EVEN ;Word align + +$DEVICE_TABLE LABEL WORD + + DEVMAC DISK ;Disks are treated as device type 0 + DEVNAM ;Rest of devices + + +; Device initialization dispatch address generator + +DEVMAC MACRO ARG + EXTRN $I_&ARG:NEAR + DW $I_&ARG + ENDM + +INIDEV_TABLE LABEL WORD + + DEVNAM ;Device initialization addresses + +INIDEV_END LABEL WORD ;End of table + + +; Device close dispatch address generator + +DEVMAC MACRO ARG + EXTRN $C_&ARG:NEAR + DW $C_&ARG + ENDM + +CLSDEV_TABLE LABEL WORD + + DEVNAM ;Device close addresses + +CLSDEV_END LABEL WORD ;End of table + + +; Device width set dispatch address generator +; +; Routine calling sequence: +; +; Entry (DX) = width + +DEVMAC MACRO ARG + EXTRN $W_&ARG:NEAR + DW $W_&ARG + ENDM + +WIDTH_TABLE LABEL WORD + + DEVNAM ;Width set addresses + + + + SUBTTL Compiler Generated Entry Points + + +;** WIDTH "device" Statement +; +; ENTRY (BX) = device name string +; (DX) = width + +$WDD: CALL $SAVREG + MOV CX,[BX] ;(CX) = length + MOV SI,[BX+2] ;(SI) = address + CALL PARSE_DEVICE ;(AL) = device + OR AL,AL ;Test for no device + JNZ wdd1 + JMP $ERC_BFN ;Error - bad file name +wdd1: CALL $$DITS ;Delete if temporary string + NOT AL ;Convert to 0 and up + CBW + SAL AX,1 ;2 * (NOT device#) + XCHG AX,DI ;(DI) = offset + JMP CS:WIDTH_TABLE[DI] ;Call width set routine - (DX) = width + + +Entries PROC FAR + +;** VARPTR() Functoin +; +; ENTRY (BX) = file number +; EXIT (BX) = address of file data block +; USES BX + +$VPT: MOV [$$SPSV],SP + PUSH SI + CALL $FBLOC ;Find file block + JNZ vpt1 + JMP ercifn ;Error - illegal file number +vpt1: MOV BX,SI ;Put address in (BX) + POP SI + RET + + + +;** EOF() Function +; +; ENTRY (BX) = file number +; EXIT (BX) = 0 or -1 if end of file +; USES BX + +$EOF: PUSH AX + MOV AH,DV_EOF ;End of file function + +comdsp: MOV [$$SPSV],SP + ADD [$$SPSV],2 ;Current stack + 2 for PUSH AX + +comds1: CALL FILE_DISPATCH + POP AX + RET + + + +;** LOC() Function +; +; ENTRY (BX) = file number +; EXIT (BX) = current record number +; USES BX + +$LOC: PUSH AX + MOV AH,DV_LOC ;LOC function + JMP comdsp + + + +;** LOF() Function +; +; ENTRY (BX) = file number +; EXIT (FAC) = length of file in bytes +; USES FAC + +$LOF: PUSH AX + MOV AH,DV_LOF ;LOF Function + JMP comdsp + + + +;** POS() Function #### not implemented #### +; +; ENTRY (BX) = file number +; EXIT (BX) = current position in sequential record +; USES BX + +;$POF: PUSH AX +; MOV AH,DV_POS ;POS Function +; JMP comdsp + + + +;** CLOSE statement +; +; ENTRY (BX) = file number +; USES NONE + +$DKC: MOV [$$SPSV],SP + +dkc1: PUSH SI + CALL $FBLOC ;Must check if file has been opened + POP SI + JZ dkcret ; No - just return + PUSH AX + MOV AH,DV_CLOSE + JMP comds1 + + +$DCA: MOV [$$SPSV],SP + CALL $CLOSF ;Close all files +dkcret: RET + + + +;** WIDTH #fnum,width +; +; ENTRY (BX) = file number +; (DX) = width +; USES NONE + +$WDF: PUSH AX + MOV AH,DV_WIDTH ;File width function + JMP comdsp + + PAGE + +;** $GET/$RGT/$PUT/$RPT - Random disk I/O +; +; ENTRY (BX) = file number +; (DX) = record number for relative calls +; USES AH + +PUTFLG EQU 1 ;PUT call +RELFLG EQU 2 ;Record number in (DX) + +$GET: PUSH AX + MOV AL,0 + +rnddsp: MOV AH,DV_RANDIO + MOV [$$SPSV],SP + ADD [$$SPSV],2 + PUSH SI + CALL $FBLOC + JZ ercbfm ;This is garbage - inconsistent + CMP [SI].FD_MODE,MD_RND + JNE ercbfm ;Not random - bad file mode + CALL PTRFIL_DISPATCH + POP SI + POP AX + RET + +$RGT: PUSH AX + MOV AL,RELFLG + JMP rnddsp + +$PUT: PUSH AX + MOV AL,PUTFLG + JMP rnddsp + +$RPT: PUSH AX + MOV AL,PUTFLG+RELFLG + JMP rnddsp + + PAGE + +;** $DKN/$DKO/$DKM - OPEN statement +; +; The OPEN statement generates one of two preambles depending upon +; the form + + +;** $DKN - Standard form of OPEN +; +; ENTRY (BX) = mode sdesc +; EXIT NONE +; USES NONE + +$DKN: MOV [$$SPSV],SP + PUSH AX + PUSH BX + CMP WORD PTR [BX],0 ;Test for empty string + JE ercbfm + MOV BX,[BX+2] ;(BX) = address of string + MOV BL,[BX] ;(BL) = first character + AND BL,-1-' ' ;Force to upper case + + MOV AL,MD_SQI ;Assume input + CMP BL,'I' + JE havmod + + MOV AL,MD_SQO ;Assume output + CMP BL,'O' + JE havmod + + MOV AL,MD_FIL ;Assume random + CMP BL,'R' + JE havmod + + MOV AL,MD_APP ;Assume append + CMP BL,'A' + JNE ercbfm ;error + +havmod: MOV [$FILMOD],AL ;Save mode for $DKM call + POP BX + CALL $$DITS ;Delete temp string + POP AX + RET + +ercbfm: JMP $ERC_BFM ;Error - Bad file mode + + +;** $DKO - SPCDSX form of OPEN statement +; +; ENTRY (BX) = file mode +; USES NONE + +$DKO: PUSH CX + PUSH BX + MOV CL,BL ;(CL) = shift count + MOV BL,1 ;Shifting 1 + SAL BL,CL ; (CL) bits + MOV [$FILMOD],BL ;Save mode for $DKM call + POP BX + POP CX + RET + + + +;** $DKM - OPEN statement processor +; +; ENTRY (BX) = file number +; (DX) = file name sdesc +; (CX) = variable record length +; USES NONE + +$DKM: MOV [$$SPSV],SP + PUSH AX + PUSH SI + + PUSH CX + PUSH DX + PUSH BX + MOV BX,DX ;(BX) = file name sdesc + MOV CX,[BX] ;(CX) = file name length + MOV SI,[BX+2] ;(SI) = file name contents + CALL $SCANF ;(AL) = device # + CALL $$DITS ;Delete temp string + POP BX + POP DX + POP CX + + OR BX,BX ;Test for 0 and neg + JBE ercifn + CALL $FBLOC ;Check if file open + JNZ ercfao ; Already open + + MOV AH,DV_OPEN + CALL OPEN_DISPATCH ;Dispatch + + POP SI + POP AX + RET + +ercfao: JMP $ERC_FAO ;Error - File already open + +ercifn: JMP $ERC_IFN ;Error - Illegal file number + + +Entries ENDP + + + SUBTTL Runtime Internal routines + +Locals PROC NEAR + +;----- Device Dispatch Routines ----------------------------------------- + + +;** $INIDEV - Device initialization dispatcher +; +; This routine calls initialization routines for each device +; in the device table. + +$INIDEV: + MOV BX,OFFSET INIDEV_TABLE-2 ;Adjust for no disk entry + +devsub: MOV DI,LAST_DEVICE_OFFSET-2 ;Use actual offset of last device + +devlp: PUSH BX + PUSH DI + CALL WORD PTR CS:[BX+DI] ;Dispatch to device routine + POP DI + POP BX + DEC DI + DEC DI + JNZ devlp ;Loop until device offset = 0 + RET + + + +;** $CLSDEV - Device close dispatcher +; +; This routine calls close routines for each device +; in the device table. + +$CLSDEV: + MOV BX,OFFSET CLSDEV_TABLE-2 ;Adjust for no disk entry + JMP devsub + + PAGE +;_____ File Dispatch Routines ------------------------------------------ + + +;** $BAKCHR - Backup character in (AL) +; +; ENTRY (AL) = character to backup +; $PTRFIL = file data block pointer +; USES AH + +$$BCH: +$BAKCHR: + PUSH SI + MOV SI,$PTRFIL + OR SI,SI + JNZ bakch1 + + POP SI + JMP $TTY_BAKC ;Console backup + +bakch1: MOV AH,DV_BAKC + +ptrdsp: CALL PTRFIL_DISPATCH + POP SI + RET + + + +;** $GETCHR - Input character into (AL) +; +; ENTRY none +; EXIT (AL) = character + +$$RCH: +$GETCHR: + PUSH SI + MOV SI,$PTRFIL + OR SI,SI + JNZ getch1 + + POP SI + JMP $TTY_SINP ;Console input + +getch1: MOV AH,DV_SINP + JMP ptrdsp + + + +;** $PUTCHR - Output character in (AL) +; +; ENTRY (AL) = character to output +; EXIT none +; USES AH + +$$WCH: +$PUTCHR: + PUSH SI + MOV SI,$PTRFIL + OR SI,SI + JNZ putch1 + + POP SI + JMP $TTY_SOUT ;Console output + +putch1: MOV AH,DV_SOUT + JMP ptrdsp + + + +;** $GETPOS - Get current file position +; +; EXIT (AH) = file position + +$$POS: +$GETPOS: + PUSH SI + MOV SI,[$PTRFIL] + OR SI,SI + JNZ getps1 + + POP SI + JMP $TTY_GPOS ;Get TTY position + +getps1: MOV AH,DV_GPOS ;Get position + JMP ptrdsp + + + +;** $GETWID - Get current file width +; +; EXIT (AH) = file width + +$$WID: +$GETWID: + PUSH SI + MOV SI,[$PTRFIL] + OR SI,SI + JNZ getwd1 + + POP SI + JMP $TTY_GWID + +getwd1: MOV AH,DV_GWID + JMP ptrdsp + + PAGE + +;** FILE_DISPATCH - File number to device dispatcher +; +;** PTRFIL_DISPATCH - PTRFIL to device dispatcher +; +;** OPEN_DISPATCH - OPEN file device dispatcher +; +; The following information is passed to the routine: +; +; (AL,CX,DX,BX) = parameters +; (SI) = file block pointer +; (DI) = device offset +; +; Both the (SI) and (DI) registers can be used as temporaries since +; they are not needed upon return. +; +; FILE_DISPATCH and OPEN_DISPATCH +; +; ENTRY (BX) = file number +; (AL) = device number for OPEN_DISPATCH +; (AH) = function to dispatch on +; (AL,CX,DX) = other parameters +; USES AH,F +; +; PTRFIL_DISPATCH +; +; ENTRY (AL) = character +; (SI) = FDB pointer +; EXIT (AL) = character +; USES AX,F + +FILE_DISPATCH: + PUSH SI + CALL $FBLOC ;(SI) = file data block pointer + JZ ercifn ;Error - illegal file number + CALL PTRFIL_DISPATCH + POP SI + RET + +OPEN_DISPATCH: + PUSH DI + PUSH BX + PUSH AX + JMP SHORT opndsp + +PTRFIL_DISPATCH: ;(SI) = file data block pointer + PUSH DI + PUSH BX + PUSH AX + + MOV AL,[SI].FD_DEVICE ;(AL) = device number +opndsp: OR AL,AL + JS getdv1 ;must be a special device + XOR AL,AL ;(AL) = 0 for disks + JMP SHORT getdv2 +getdv1: NEG AL ;(AL) = - device number for special +getdv2: CBW + SAL AX,1 + MOV DI,AX ;(DI) = device offset + MOV BX,CS:$DEVICE_TABLE[DI] + OR BX,BX ;If entry is 0, then unavailable + JZ ercdna ; Error + POP AX ;(AH) = function code + PUSH AX + XCHG AH,AL + CBW + ADD BX,AX ;Add function code offset to dispatch + MOV BX,CS:[BX] ;Get address of routine + MOV [DISPATCH_ADDR],BX ;Save it for indirect call + POP AX ;Restore (AL) + POP BX ;Restore (BX) + CALL [DISPATCH_ADDR] ;Execute routine + POP DI + RET + +ercdna: JMP $ERC_DNA + + PAGE + +;** $CLOSF - Close all files +; +; ENTRY NONE +; EXIT NONE +; USES NONE + +$CLOSF: + PUSH BX + PUSH SI + +closf1: MOV SI,[$FILPT] ;Get address of next file block + OR SI,SI + JZ closf3 ;Finished + + MOV BL,[SI].FB_NUM ;Get file # + XOR BH,BH + CALL FAR PTR dkc1 ;Close file in (BX) + JMP closf1 ;Keep looping + +closf3: POP SI + POP BX + RET + + PAGE + +;** $SCANF - Scan file name +; +; ENTRY (SI) = text pointer +; (CX) = length +; EXIT (AL) = device # +; FILNAM = (device # , filename.ext) +; USES CX,SI + +$SCANF: + CALL PARSE_DEVICE ;(AL) = device # + MOV [$FILNAM],AL ;Save device # + OR AL,AL + JS _030 + XOR AL,AL ;(AL) = 0 for disks +_030: PUSH AX + PUSH DX + PUSH DI + MOV DI,OFFSET DC:$FILNAM+1 + MOV DX,FILNAM_LENGTH + + +scan1: JCXZ filspc ;End of string + DEC CX + LODSB ;Get character + CMP AL,' ' + JAE _040 + +ercbfn: JMP $ERC_BFN + +_040: CMP AL,'.' + JE fillnm + STOSB ;Store character + DEC DX + JNZ scan1 ;Keep looking for characters + +gotnam: POP DI + POP DX + POP AX + RET + +fillnm: CMP DX,FILNAM_LENGTH + JE ercbfn ;Error - extension only ! + CMP DX,3 + JB ercbfn ;Error - 2nd dot + JE scan1 ;Scan extension like filename + MOV AL,' ' + STOSB ;Fill with blank + DEC DX + JMP fillnm ;Keep filling + +filspc: MOV AL,' ' ;Fill short name with spaces + STOSB + DEC DX + JNZ filspc ;Keep filling + JMP gotnam ;Done with name + + PAGE + +;** PARSE_DEVICE - Parse device name from string +; +; ENTRY (CX) = length of string +; (SI) = string address +; EXIT (AL) = device # (0 = default , - = special) +; (CX) = remaining count +; (SI) = address of remaining string + +PARSE_DEVICE: + PUSH DX + PUSH DI + PUSH SI + MOV DX,CX ;(DX) = original length + JCXZ nodvnm ;If length = 0 , no device name + +devscn: LODSB ;Get character + CMP AL,':' + JE devnm ;Found possible name + LOOP devscn + +nodvnm: MOV CX,DX ;No device name - restore everything + POP SI + POP DI + POP DX + XOR AL,AL ;Default device to 0 + RET + +devnm: POP DI ;Restore old string pointer + XCHG SI,DI + PUSH DI ;Save new string pointer + SUB DX,CX ;(DX) = device name length + JZ ercbfn ;Length = 0 - bad file name + DEC CX ;Count off : + CMP DX,1 + JE dsknam ;Length = 1 - must be disk name + + MOV DI,OFFSET DEVICE_NAME_TABLE-1 +devsrc: PUSH SI + PUSH DX + +devlop: INC DI + LODSB + CALL UPCASE ;Convert to upper case + TEST BYTE PTR CS:[DI],80H ;Check to see if at device (long name) + JNZ nmtch2 + CMP CS:[DI],AL + JNE nomtch + DEC DX + JNZ devlop + +fnddev: INC DI + MOV AL,CS:[DI] ;Get device # + OR AL,AL + JNS nomtch ;Not a device # + + POP SI + POP SI +devret: POP SI ;(SI) = pointer after : + POP DI + POP DX + RET ;(CX) = chars left , (AL) = device # + +nmtch1: INC DI +NOMTCH: TEST BYTE PTR CS:[DI],80H ;Check for device # + JZ nmtch1 ; No +nmtch2: POP DX + POP SI + CMP BYTE PTR CS:[DI+1],0 ;End of table? + JNE devsrc ; No - check next entry + +_050: JMP ercbfn ;Error - bad filename (device name) + +dsknam: LODSB ;Refetch character + CALL UPCASE + SUB AL,'A'-1 ;Convert letter to 1-26 (let @ be 0) + JC _050 ; Less than @ + CMP AL,'Z' and 01FH + JNC _050 ; Greater than Z + JMP devret + +UPCASE: CMP AL,'a' ;Convert (AL) to upper case + JB upret + CMP AL,'z' + JA upret + AND AL,255-' ' +upret: RET + + PAGE + +;** $FRCSQO - Force MD_RND to MD_SQO + +$FRCSQO: + CMP [$FILMOD],MD_RND + JNE frcret + MOV [$FILMOD],MD_SQO +frcret: RET + + + +;** $DEVOPN - Special device open common routine +; +; ENTRY (AL) = file device +; (AH) = valid file modes +; (CX) = buffer size (not including basic FDB size) +; (DL) = file width +; (DH) = initial file position +; (BX) = file number +; USES CX,DI + +$DEVOPN: + TEST [$FILMOD],AH ;Check for valid file mode + JZ ercbfm1 ; Bad file mode + + XCHG BX,CX + ADD BX,FD_BUFFER ;(BX) = size of block to allocate + CALL $FBALC ;Allocate block + XCHG BX,CX ;(BX) = file number + MOV DI,[$FILPT] ;Link in new file block + MOV [SI].BL_LNK,DI + MOV [$FILPT],SI ; right in front + MOV [SI].FB_NUM,BL ;Set file number + + MOV [SI].FD_DEVICE,AL ;Set file device + MOV WORD PTR [SI].FD_WIDTH,DX ;Set file width/position + RET + +ercbfm1:JMP $ERC_BFM ;Bad file mode + + +Locals ENDP + +CODE ENDS + + END diff --git a/3_source_code/BASLIB-86/TABMAC.INC b/3_source_code/BASLIB-86/TABMAC.INC new file mode 100644 index 0000000..74712ec --- /dev/null +++ b/3_source_code/BASLIB-86/TABMAC.INC @@ -0,0 +1,23 @@ +; Special Table Generation Macros + +ENTORG MACRO First_entry + .XCREF +___ZZZ= First_entry + .CREF + ENDM + + +ENT MACRO Lab,Incr +Lab= ___ZZZ + .XCREF +___ZZZ= ___ZZZ+Incr + .CREF + ENDM + + +ENTI MACRO Incr + .XCREF +___ZZZ= ___ZZZ+Incr + .CREF + ENDM + From 4169f7682e942120719f41e547c0993954a4bead Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 14 Jul 2026 17:59:19 -0700 Subject: [PATCH 33/53] Transcription of Bundle 9 - IODISK.ASM Code and Listing Uses: TABMAC.INC DEVDEF.INC SYSTEM.INC --- 2_printed_files/bundle_09/IODISK.ASM | 2161 ++++++++++++++++++++++++++ 3_source_code/BASLIB-86/IODISK.ASM | 1022 ++++++++++++ 2 files changed, 3183 insertions(+) create mode 100644 2_printed_files/bundle_09/IODISK.ASM create mode 100644 3_source_code/BASLIB-86/IODISK.ASM diff --git a/2_printed_files/bundle_09/IODISK.ASM b/2_printed_files/bundle_09/IODISK.ASM new file mode 100644 index 0000000..765d3ea --- /dev/null +++ b/2_printed_files/bundle_09/IODISK.ASM @@ -0,0 +1,2161 @@ +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-1 + + + +1 TITLE IODISK - Disk I/O Drivers for BASCOM-86 +2 +3 ; This module contains the disk operating system interface +4 ; for the device I/O independent package. It also includes +5 ; other operating system features of BASIC. +6 +7 C INCLUDE TABMAC.INC +8 C ; Special Table Generation Macros +9 C +10 C ENTORG MACRO First_entry +11 C .XCREF +12 C ___ZZZ= First_entry +13 C .CREF +14 C ENDM +15 C +16 C +17 C ENT MACRO Lab,Incr +18 C Lab= ___ZZZ +19 C .XCREF +20 C ___ZZZ= ___ZZZ+Incr +21 C .CREF +22 C ENDM +23 C +24 C +25 C ENTI MACRO Incr +26 C .XCREF +27 C ___ZZZ= ___ZZZ+Incr +28 C .CREF +29 C ENDM +30 C +31 +32 0000 DATA SEGMENT WORD PUBLIC 'DATA' +33 +34 C INCLUDE DEVDEF.INC + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-2 + + + +35 C PAGE +36 C +37 C ; DEVDEF.INC - Device Independent I/O Definitions +38 C +39 C INCLUDE SYSTEM.INC +40 C ; Operating System Selection +41 C +42 = 0000 C _IBM_= 0 +43 C +44 = 0001 C _MSDOS_= 1 +45 = 0000 C _CPM_= 0 +46 C +47 C ; Overrides +48 C +49 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ +50 C +51 C if1 +52 C if _CPM_ +53 C %OUT ! CP/M-86 Version +54 C endif +55 C if _MSDOS_ +56 C %OUT ! MSDOS Version +57 C endif +58 C if _IBM_ +59 C %OUT ! IBM Personal Computer +60 C endif +61 C +62 C if _MSDOS_+_CPM_ ne 1 +63 C %OUT ##################### Error - Bad Operating System Selection +64 C +65 C error +66 C endif +67 C endif +68 C + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-3 + + + +69 C PAGE +70 C +71 C DEVNAM MACRO +72 C DEVMAC KYBD +73 C DEVMAC SCRN +74 C if _IBM_ +75 C DEVMAC CAS1 +76 C DEVMAC COM1 +77 C DEVMAC COM2 +78 C endif +79 C DEVMAC LPT1 +80 C if _IBM_ +81 C DEVMAC LPT2 +82 C DEVMAC LPT3 +83 C endif +84 C ENDM +85 C +86 = FFFF C ___DEV= -1 +87 C +88 C DEVMAC MACRO ARG +89 C DN_&ARG= ___DEV +90 C .xcref +91 C ___DEV= ___DEV-1 +92 C .cref +93 C ENDM +94 C +95 C DEVNAM +96 C +97 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-4 + + + +98 C PAGE +99 C +100 C DSPNAM MACRO +101 C DSPMAC EOF ;EOF function +102 C DSPMAC LOC ;LOC function +103 C DSPMAC LOF ;LOF function +104 C ; DSPMAC POS ;POS function +105 C DSPMAC CLOSE ;CLOSE statement +106 C DSPMAC WIDTH ;WIDTH statement +107 C DSPMAC RANDIO ;GET/PUT statements +108 C DSPMAC OPEN ;OPEN statement +109 C DSPMAC BAKC ;Backup character +110 C DSPMAC SINP ;Serial input +111 C DSPMAC SOUT ;Serial output +112 C DSPMAC GPOS ;Get current position +113 C DSPMAC GWID ;Get current width +114 C ENDM +115 C +116 C +117 C ; Device Function Dispatch Table Offsets +118 C +119 C +120 C DSPMAC MACRO func +121 C ENT DV_&func,2 +122 C ENDM +123 C +124 C +125 C ENTORG 0 +126 C DSPNAM +127 C ENT DV_TABLEN,0 +128 C + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-5 + + + +129 C PAGE +130 C +131 C ; File Mode Definitions +132 C +133 = 0001 C MD_SQI EQU 1 +134 = 0002 C MD_SQO EQU 2 +135 = 0004 C MD_RND EQU 4 +136 = 0004 C MD_FIL EQU 4 +137 = 0008 C MD_APP EQU 8 +138 = 0010 C MD_KIL EQU 16 +139 = 0020 C MD_IBM EQU 32 +140 = 0040 C MD_USR EQU 64 +141 = 0080 C MD_BIN EQU 128 +142 C +143 C +144 C ; Operating System dependent field sizes +145 C +146 = 001A C EOFCHR= 'Z' and 1fh +147 C +148 = 0026 C FILNAML= 38 ;Length of $FILNAM +149 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) +150 C +151 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs +152 = 0080 C REC_LENGTH= 128 ;128 byte sectors +153 C + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-6 + + + +154 C PAGE +155 C +156 C ;----- Basic Interpreter style File Data Block ----- +157 C +158 C ; Link block offsets +159 C +160 = FFFA C BL_SIZE= -6 ;Link block size (2 bytes of misc) +161 = FFFB C FB_NUM= -5 ; File number +162 = FFFC C BL_LEN= -4 ;Block size +163 = FFFE C BL_LNK= -2 ;Block link +164 C +165 C ; File Data Block offsets +166 C +167 C FILE_DATA_BLOCK STRUC +168 C +169 0000 ?? C FD_MODE DB ? ;File mode of open +170 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area +171 ?? C +172 ] C +173 C +174 0027 ???? C FD_CURLOC DW ? ;Current record number +175 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector +176 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer +177 002B 03 [ C DB 3 DUP (?) ;Unused +178 ?? C +179 ] C +180 C +181 002E ?? C FD_DEVICE DB ? ;Device number +182 002F ?? C FD_WIDTH DB ? ;File width +183 0030 ?? C FD_POS DB ? ;Current file position +184 0031 ?? C FD_FLAGS DB ? ;Used for load and save +185 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion +186 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer +187 ?? C +188 ] C +189 C +190 C +191 C ; 5.0 Variable Record Information +192 C +193 00B3 ???? C FR_VRECL DW ? ;Variable record length +194 00B5 ???? C FR_PHYREC DW ? ;Current physical record number +195 00B7 ???? C FR_LOGREC DW ? ;Current logical record number +196 00B9 ?? C DB ? ;Future use +197 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O +198 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer +199 ?? C +200 ] C +201 C +202 C +203 00BD C FILE_DATA_BLOCK ENDS +204 C +205 C +206 C ; End of DEVDEF.INC +207 + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-7 + + + +208 PAGE +209 +210 ; Operating System Equates and Macros +211 +212 +213 ; MSDOS/CPM Operating System Function Codes +214 +215 = 000D C_REST= 13 +216 = 000E C_SDRV= 14 +217 = 000F C_OPEN= 15 +218 = 0010 C_CLOS= 16 +219 = 0011 C_SEAR= 17 +220 = 0013 C_DELE= 19 +221 = 0014 C_READ= 20 +222 = 0015 C_WRIT= 21 +223 = 0016 C_MAKE= 22 +224 = 0017 C_RENA= 23 +225 = 0019 C_GDRV= 25 +226 = 001A C_BUFF= 26 +227 = 0021 C_RNDR= 33 +228 = 0022 C_RNDW= 34 +229 +230 +231 ; MSDOS/CPM File Control Block Offsets +232 +233 = 0001 FCB_FN= 1 +234 = 0009 FCB_FT= 9 +235 = 000C FCB_EX= 12 +236 = 000E FCB_RSIZ= 14 ;MSDOS +237 = 000F FCB_RC= 15 ;MSDOS +238 = 0010 FCB_FSIZ= 16 ;MSDOS +239 = 0020 FCB_NR= 32 +240 = 0021 FCB_RN= 33 +241 +242 +243 ; MSDOS Call Macro +244 +245 if _MSDOS_ +246 CALLOS MACRO func +247 IFNB +248 MOV AH,func +249 ENDIF +250 INT 33 +251 ENDM +252 endif +253 + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-8 + + + +254 PAGE +255 +256 ; External Data Variables +257 +258 EXTRN $FILNAM:BYTE, $FILNM2:BYTE, $FILMOD:BYTE +259 EXTRN $FILPT:WORD +260 EXTRN $$SPSV:WORD +261 +262 +263 ; Public Data Variables +264 +265 if _CPM_ +266 PUBLIC $DIRTMP +267 $DIRTMP DB REC_LENGTH DUP (?) ;Temporary buffer +268 endif +269 +270 +271 ; Local Data Variables +272 +273 0000 ???? RECORD DW ? ;Current record number +274 0002 ???? LBUFF DW ? ;Logical buffer address +275 0004 ???? PBUFF DW ? ;Physical buffer address +276 +277 0006 DATA ENDS +278 +279 DC GROUP DATA + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-1 + + + +280 +281 +282 0000 CODE SEGMENT BYTE PUBLIC 'CODE' +283 +284 ASSUME CS:CODE, DS:DC, ES:DC +285 +286 ; Compiler Generated Entries +287 +288 PUBLIC $DKK,$DKR,$FL0,$FIL,$RS2,$ZZ1 +289 +290 +291 ; Run-time entries +292 +293 PUBLIC $D_DISK +294 +295 +296 ; Run-time externals +297 +298 EXTRN $$DITS:NEAR, $SAVREG:NEAR +299 EXTRN $FBALC:NEAR, $FBDEA:NEAR +300 EXTRN $SCANF:NEAR, $CLOSF:NEAR, $DEVOPN:NEAR +301 EXTRN $$WCHT:NEAR, $$TCR:NEAR +302 EXTRN $TTY_GPOS:NEAR, $TTY_GWID:NEAR +303 +304 EXTRN $ERC_FC:NEAR +305 EXTRN $ERC_BFM:NEAR +306 EXTRN $ERC_BFN:NEAR +307 EXTRN $ERC_BRN:NEAR +308 EXTRN $ERC_DFL:NEAR +309 EXTRN $ERC_FAE:NEAR +310 EXTRN $ERC_FAO:NEAR +311 EXTRN $ERC_FNF:NEAR +312 EXTRN $ERC_FOV:NEAR +313 EXTRN $ERC_IOE:NEAR +314 EXTRN $ERC_TMF:NEAR +315 +316 if _MSDOS_ +317 EXTRN $DNORM:NEAR +318 endif +319 + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-2 + + + +320 PAGE +321 +322 ; Device Independent Disk Interface +323 +324 DSPMAC MACRO func +325 DW DISK_&func +326 ENDM +327 +328 0000 $D_DISK: +329 DSPNAM +330 0000 003D R + DW DISK_EOF +331 0002 006D R + DW DISK_LOC +332 0004 007A R + DW DISK_LOF +333 0006 0018 R + DW DISK_CLOSE +334 0008 0097 R + DW DISK_WIDTH +335 000A 0245 R + DW DISK_RANDIO +336 000C 0145 R + DW DISK_OPEN +337 000E 009B R + DW DISK_BAKC +338 0010 00D7 R + DW DISK_SINP +339 0012 0109 R + DW DISK_SOUT +340 0014 009F R + DW DISK_GPOS +341 0016 00A3 R + DW DISK_GWID +342 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-3 + + + +343 PAGE +344 +345 0018 devio_disk PROC NEAR +346 +347 +348 0018 DISK_CLOSE: +349 0018 80 3C 02 CMP [SI].FD_MODE,MD_SQO +350 001B 75 0E JNE noforc ;Don't dump buffer +351 +352 001D B0 1A MOV AL,EOFCHR +353 001F E8 0109 R CALL DISK_SOUT ;Write EOF character +354 0022 80 7C 29 00 CMP [SI].FD_ORNOFS,0 +355 0026 74 03 JE noforc ;Buffer already dumped +356 +357 0028 E8 035D R CALL WRITE_SECTOR ;Write sector +358 +359 002B 51 noforc: PUSH CX +360 002C 52 PUSH DX +361 002D 8D 54 01 LEA DX,[SI].FD_FCB +362 0030 E8 038B R CALL SETBUF ;Set buffer address +363 CALLOS C_CLOS ;Close file +364 0033 B4 10 + MOV AH,C_CLOS +365 0035 CD 21 + INT 33 +366 0037 E8 0000 E CALL $FBDEA ;Deallocate file buffer +367 003A 5A POP DX +368 003B 59 POP CX +369 003C C3 RET +370 +371 +372 +373 003D DISK_EOF: +374 003D 80 3C 02 CMP [SI].FD_MODE,MD_SQO +375 0040 74 28 JE ercbfm ;Not for output files +376 +377 0042 80 7C 29 00 ornchk: CMP [SI].FD_ORNOFS,0 +378 0046 74 1B JE waseof +379 +380 0048 33 DB XOR BX,BX +381 004A 80 3C 04 CMP [SI].FD_MODE,MD_RND +382 004D 74 1A JE eofret ;Not end of file +383 +384 004F 38 5C 2A CMP [SI].FD_NMLOFS,BL ;(BX) is 0 +385 0052 75 05 JNE chkctz ;Still characters in teh buffer +386 +387 0054 E8 0333 R CALL READ_SECTOR ;Read next sector +388 0057 EB E9 JMP ornchk +389 +390 0059 BB 0080 chkctz: MOV BX,REC_LENGTH +391 005C 2A 5C 2A SUB BL,[SI].FD_NMLOFS ;(BX) = character offset +392 005F 80 78 33 1A CMP [SI+BX].FD_BUFFER,EOFCHR +393 +394 0063 BB 0000 waseof: MOV BX,0 ;(BX) = not end of file +395 0066 75 01 JNE eofret +396 0068 4B DEC BX ;(BX) = -1 if end of file + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-4 + + + +397 0069 C3 eofret: RET +398 +399 006A E9 0000 E ercbfm: JMP $ERC_BFM +400 +401 006D DISK_LOC: +402 006D 80 3C 04 CMP [SI].FD_MODE,MD_RND +403 0070 8B 5C 27 MOV BX,[SI].FD_CURLOC ;Use CURLOC for sequential +404 0073 75 04 JNE loc1 +405 0075 8B 9C 00B7 MOV BX,[SI].FR_LOGREC ;Use LOGREC for random +406 0079 C3 loc1: RET +407 +408 +409 +410 007A DISK_LOF: +411 007A 51 PUSH CX +412 007B 52 PUSH DX +413 007C 53 PUSH BX +414 007D 8B 54 11 MOV DX,WORD PTR [SI].FD_FCB+FCB_FSIZ ;Get length of file +415 0080 8B 4C 13 MOV CX,WORD PTR [SI].FD_FCB+FCB_FSIZ+2 +416 0083 33 DB XOR BX,BX +417 0085 33 FF XOR DI,DI +418 0087 B8 C000 MOV AX,(64+80h)*100h ;(AX) = (exp+128,sign) +419 008A E8 0000 E CALL $DNORM ;Normalize as double +420 008D 5B POP BX +421 008E 5A POP DX +422 008F 59 POP CX +423 0090 C3 RET +424 +425 +426 +427 0091 DISK_POS: +428 0091 33 DB XOR BX,BX +429 0093 8A 5C 32 MOV BL,[SI].FD_OUTPOS ;(BX) = current file position +430 0096 C3 RET +431 +432 +433 +434 0097 DISK_WIDTH: +435 0097 88 54 2F MOV [SI].FD_WIDTH,DL ;Set file width +436 009A C3 RET +437 + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-5 + + + +438 PAGE +439 +440 009B DISK_BAKC: +441 009B FE 44 2A INC [SI].FD_NMLOFS ;Backup 1 character +442 009E C3 RET +443 +444 +445 +446 009F DISK_GPOS: +447 009F 8A 64 32 MOV AH,[SI].FD_OUTPOS ;Get file output position +448 00A2 C3 RET +449 +450 +451 +452 00A3 DISK_GWID: +453 00A3 8A 64 2F MOV AH,[SI].FD_WIDTH ;Get file width +454 00A6 C3 RET +455 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-6 + + + +456 PAGE +457 +458 00A7 DISK_SINPB: +459 00A7 80 3C 04 CMP [SI].FD_MODE,MD_RND +460 00AA 75 03 JNE sinp1 +461 +462 00AC EB 3D 90 JMP SINP_50 ;Serial input from random +463 +464 00AF 80 7C 2A 00 sinp1: CMP [SI].FD_NMLOFS,0 +465 00B3 74 13 JE fillsq ;Sector is empty - get another +466 +467 00B5 53 PUSH BX +468 00B6 33 DB XOR BX,BX +469 00B8 8A 5C 29 MOV BL,[SI].FD_ORNOFS +470 00BB 2A 5C 2A SUB BL,[SI].FD_NMLOFS +471 00BE FE 4C 2A DEC [SI].FD_NMLOFS +472 00C1 8A 40 33 MOV AL,[SI+BX].FD_BUFFER ;(AL) = character +473 00C4 5B POP BX +474 00C5 0A C0 OR AL,AL ;Clear carry +475 00C7 C3 RET +476 +477 00C8 80 7C 29 00 fillsq: CMP [SI].FD_ORNOFS,0 +478 00CC 74 05 JE fills1 ;At end of file +479 +480 00CE E8 0333 R CALL READ_SECTOR ;Read next sector +481 00D1 75 04 JNE DISK_SINP ; Not at eof - try with new buffer +482 +483 00D3 F9 fills1: STC ;Set carry +484 00D4 B0 1A MOV AL,EOFCHR ;Return EOF character +485 +486 00D6 C3 sinret: RET +487 +488 00D7 DISK_SINP: +489 00D7 E8 00A7 R CALL DISK_SINPB ;Read binary character +490 00DA 72 FA JC sinret ; End of file +491 +492 00DC 3C 1A CMP AL,EOFCHR ;End of file character? +493 00DE F8 CLC ;Assume not +494 00DF 75 F5 JNE sinret ; Return +495 +496 00E1 C6 44 29 00 MOV [SI].FD_ORNOFS,0 ;Clear these offsets +497 00E5 C6 44 2A 00 MOV [SI].FD_NMLOFS,0 +498 00E9 F9 STC +499 00EA C3 RET +500 +501 00EB SINP_50: ;Serial input from random file +502 00EB 53 PUSH BX +503 00EC E8 00F6 R CALL FOVCHK ;Field overflow check +504 00EF 8A 80 00BB MOV AL,[SI+BX-1].FR_FIELD ;Get character +505 00F3 F8 CLC ;Clear carry +506 00F4 5B POP BX +507 00F5 C3 RET +508 +509 + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-7 + + + +510 00F6 8B 9C 00BA FOVCHK: MOV BX,[SI].FR_OUTPOS ;Get current position +511 00FA 3B 9C 00B3 CMP BX,[SI].FR_VRECL ;Check for end of record +512 00FE 74 06 JE ercfov ; Yes - field overflow +513 0100 43 INC BX ;Bump pointer +514 0101 89 9C 00BA MOV [SI].FR_OUTPOS,BX ;Save new position +515 0105 C3 RET +516 +517 0106 E9 0000 E ercfov: JMP $ERC_FOV +518 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-8 + + + +519 PAGE +520 +521 = 000D CR= 13 +522 +523 0109 DISK_SOUT: +524 0109 80 3C 04 CMP [SI].FD_MODE,MD_RND +525 010C 75 03 JNE sout1 +526 +527 010E EB 2A 90 JMP SOUT_50 ;Serial output to random +528 +529 0111 80 7C 29 80 sout1: CMP [SI].FD_ORNOFS,REC_LENGTH +530 0115 75 05 JNE sout2 ;Not at end of sector +531 +532 0117 50 PUSH AX +533 0118 E8 035D R CALL WRITE_SECTOR ;Write previous sector +534 011B 58 POP AX +535 +536 011C 53 sout2: PUSH BX +537 011D 33 DB XOR BX,BX +538 011F 8A 5C 29 MOV BL,[SI].FD_ORNOFS ;(BX) = buffer offset +539 0122 88 40 33 MOV [SI+BX].FD_BUFFER,AL ;Stuff character +540 0125 5B POP BX +541 0126 FE 44 29 INC [SI].FD_ORNOFS +542 +543 0129 3C 0D soutps: CMP AL,CR +544 012B 75 05 JNE sout3 +545 +546 012D C6 44 32 00 MOV [SI].FD_OUTPOS,0 ;Zero position +547 0131 C3 RET +548 +549 0132 3C 20 sout3: CMP AL,' ' +550 0134 F5 CMC +551 0135 80 54 32 00 ADC [SI].FD_OUTPOS,0 ;Add 1 if printing character +552 0139 C3 RET +553 +554 013A SOUT_50: ;Serial output to random file +555 013A 53 PUSH BX +556 013B E8 00F6 R CALL FOVCHK ;Check for field overflow +557 013E 88 80 00BB MOV [SI+BX-1].FR_FIELD,AL ;Store character +558 0142 5B POP BX +559 0143 EB E4 JMP soutps ;Update position +560 + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-9 + + + +561 PAGE +562 +563 0145 DISK_OPEN: +564 0145 52 PUSH DX +565 0146 51 PUSH CX +566 +567 0147 80 3E 0000 E 04 CMP [$FILMOD],MD_RND ;See if random +568 014C 75 07 JNE notrnd ; No +569 014E 0B C9 OR CX,CX ;See if default record size +570 0150 75 03 JNE notrnd ; No +571 0152 B9 0080 MOV CX,REC_LENGTH ;Use record length as default +572 0155 51 notrnd: PUSH CX ;Save it for now +573 = 0089 ___TMP= FR_FIELD-FD_BUFFER ;Size beyond basic FDB +574 0156 81 C1 0089 ADD CX,___TMP +575 015A BA 00FF MOV DX,255 ;(DH,DL) = position,width +576 015D B4 FF MOV AH,255 ;(AH) = all file modes legal +577 015F E8 0000 E CALL $DEVOPN ;Allocate file block, etc. +578 0162 59 POP CX ;Get it back +579 0163 89 8C 00B3 MOV [SI].FR_VRECL,CX ;Set random record length +580 0167 56 PUSH SI +581 0168 8D 7C 01 LEA DI,[SI].FD_FCB +582 016B BE 0000 E MOV SI,OFFSET DC:$FILNAM +583 016E B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive +584 0171 F3/ A4 REP MOVSB ;Move in name into file block +585 0173 5E POP SI +586 0174 E8 038B R CALL SETBUF ;Set buffer address +587 +588 if _MSDOS_ +589 0177 80 3E 0000 E 08 CMP [$FILMOD],MD_APP +590 017C 75 03 JNE nochk +591 017E E8 03DF R CALL CHKFOP ;See if open +592 0181 nochk: +593 endif +594 +595 0181 8D 54 01 LEA DX,[SI].FD_FCB ;(DX) = FCB address +596 0184 80 3E 0000 E 02 CMP [$FILMOD],MD_SQO +597 0189 75 12 JNE opnfil ;Not sequential output +598 +599 if _MSDOS_ +600 018B E8 03DF R CALL CHKFOP ;Check if already open +601 endif +602 +603 CALLOS C_DELE ;Delete existing file +604 018E B4 13 + MOV AH,C_DELE +605 0190 CD 21 + INT 33 +606 +607 0192 makfil: CALLOS C_MAKE ;Create new file +608 0192 B4 16 + MOV AH,C_MAKE +609 0194 CD 21 + INT 33 +610 0196 FE C0 INC AL +611 0198 75 23 JNZ opnset ;Continue with OPEN +612 019A E9 0385 R JMP erctmf ;Directory full +613 +614 019D opnfil: CALLOS C_OPEN ;Open existing file + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-10 + + + +615 019D B4 0F + MOV AH,C_OPEN +616 019F CD 21 + INT 33 +617 01A1 FE C0 INC AL +618 01A3 75 18 JNE opnset ;Continue with OPEN +619 +620 if _MSDOS_ +621 01A5 80 3E 0000 E 08 CMP [$FILMOD],MD_APP +622 01AA 75 07 JNE ntapnf +623 +624 01AC C6 06 0000 E 02 MOV [$FILMOD],MD_SQO ;Default to sequential output +625 01B1 EB DF JMP makfil +626 01B3 ntapnf: +627 endif +628 +629 01B3 80 3E 0000 E 04 CMP [$FILMOD],MD_RND +630 01B8 74 D8 JE makfil ;Create file for random +631 01BA E9 04B0 R JMP ercfnf +632 +633 01BD A0 0000 E opnset: MOV AL,[$FILMOD] +634 01C0 88 04 MOV [SI].FD_MODE,AL ;Everything is OK - set file mode +635 +636 if _MSDOS_ +637 01C2 C7 44 0F 0080 MOV WORD PTR [SI].FD_FCB+FCB_RSIZ,REC_LENGTH +638 endif +639 +640 01C7 80 3C 04 CMP [SI].FD_MODE,MD_RND +641 01CA 74 0D JE opnret ;Done if random +642 +643 if _MSDOS_ +644 01CC 80 3C 08 CMP [SI].FD_MODE,MD_APP +645 01CF 74 0B JE appfin ;Special if append +646 endif +647 +648 01D1 80 3C 01 CMP [SI].FD_MODE,MD_SQI +649 01D4 75 03 JNE opnret ;Done if not input +650 +651 01D6 E8 0333 R CALL READ_SECTOR ;Read 1st sector +652 +653 01D9 59 opnret: POP CX +654 01DA 5A POP DX +655 01DB C3 RET +656 +657 if _MSDOS_ +658 +659 01DC appfin: ;Special code to find end of file +660 +661 01DC 83 7C 11 00 CMP WORD PTR [SI].FD_FCB+FCB_FSIZ,0 ;Test for empty file +662 01E0 75 0B JNE ntzrfl +663 01E2 83 7C 13 00 CMP WORD PTR [SI].FD_FCB+FCB_FSIZ+2,0 +664 01E6 75 05 JNE ntzrfl +665 +666 01E8 C6 04 02 MOV [SI].FD_MODE,MD_SQO ;Set mode to output +667 01EB EB EC JMP opnret ; and return +668 + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-11 + + + +669 01ED 8D 7C 22 ntzrfl: LEA DI,[SI].FD_FCB+FCB_RN ;Point to random record number +670 01F0 56 PUSH SI +671 01F1 83 C6 11 ADD SI,FD_FCB+FCB_FSIZ ;Point to file size +672 01F4 F6 04 7F TEST BYTE PTR [SI],127 ;See if multiple of 128 +673 01F7 9C PUSHF ; Save flags +674 01F8 AC LODSB ;Get low order byte of file size +675 01F9 D0 E0 SAL AL,1 ;Rotate high bit into carry +676 01FB AD LODSW ;Get middle word +677 01FC D1 E0 SAL AX,1 ;Rotate carry in and high bit out +678 01FE AB STOSW ;Save low word of file size +679 01FF AC LODSB ;Get high order byte +680 0200 B4 00 MOV AH,0 ;Clear high byte of record number +681 0202 D1 E0 SAL AX,1 ;Rotate carry in +682 0204 AB STOSW ;Save high word of record number +683 0205 9D POPF ;Restore flags +684 0206 5E POP SI ;Restore pointer to file data block +685 0207 75 03 JNZ nomtrc ;Record is not empty +686 +687 0209 E8 0235 R CALL BAKURN ;Backup record number +688 +689 020C E8 0333 R nomtrc: CALL READ_SECTOR ;Read record +690 020F E8 0235 R CALL BAKURN ;Backup record number +691 0212 33 D2 XOR DX,DX ;Number of characters in buffer +692 +693 0214 E8 00A7 R redoef: CALL DISK_SINPB ;Read binary character +694 0217 72 07 JC setsqm ; Hit physical EOF +695 +696 0219 3C 1A CMP AL,EOFCHR +697 021B 74 08 JE setsqo ;Found end of file +698 +699 021D 42 INC DX +700 021E EB F4 JMP redoef ;Keep looping +701 +702 0220 33 D2 setsqm: XOR DX,DX ;Start of record +703 0222 E8 0235 R CALL BAKURN ;Read 1 past +704 +705 0225 C6 04 02 setsqo: MOV [SI].FD_MODE,MD_SQO ;Ready for sequential output now +706 0228 8D 7C 27 LEA DI,[SI].FD_CURLOC ;Point to current location +707 022B 33 C0 XOR AX,AX +708 022D AB STOSW ;Clear current location +709 022E 88 15 MOV [DI],DL ;Set number of bytes in buffer +710 0230 88 44 32 MOV [SI].FD_OUTPOS,AL ;Clear print position +711 0233 EB A4 JMP opnret ;Done with append +712 +713 0235 83 6C 22 01 BAKURN: SUB WORD PTR [SI].FD_FCB+FCB_RN,1 ;Decrement random record number +714 0239 73 03 JAE bakret ;Done - no underflow +715 023B FF 4C 24 DEC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Decrement high word +716 023E C3 bakret: RET +717 +718 endif +719 + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-12 + + + +720 PAGE +721 +722 = 0001 PUTFLG= 1 ;on = PUT , off = GET +723 = 0002 RELFLG= 2 ;on = relative , off = sequential +724 = 0004 DIRFLG= 4 ;on = WRITE , off = READ +725 +726 023F E9 0000 E ercfc: JMP $ERC_FC +727 0242 E9 0000 E ercbrn: JMP $ERC_BRN +728 +729 0245 DISK_RANDIO: +730 0245 51 PUSH CX +731 0246 52 PUSH DX +732 0247 53 PUSH BX +733 0248 A8 02 TEST AL,RELFLG ;Check for relative record number +734 024A 75 07 JNZ rand1 +735 +736 024C 8B 94 00B7 MOV DX,[SI].FR_LOGREC ;(DX) = current logical record +737 0250 42 INC DX ;Bump by 1 +738 0251 EB 04 JMP SHORT rand2 +739 +740 0253 0B D2 rand1: OR DX,DX ;Check for bad record number +741 0255 7E EB JLE ercbrn ; Error - 0 or negative +742 +743 0257 89 94 00B7 rand2: MOV [SI].FR_LOGREC,DX ;Save next record number +744 025B 4A DEC DX ;(DX) = current logical record number +745 025C C7 84 00BA 0000 MOV [SI].FR_OUTPOS,0 ;Clear output position +746 0262 8B 9C 00B3 MOV BX,[SI].FR_VRECL ;(BX) = logical record length +747 0266 53 PUSH BX +748 0267 81 FB 0080 CMP BX,REC_LENGTH ;Check if logical size = physical +749 026B 74 16 JE rand3 +750 +751 026D 93 XCHG AX,BX ;Save (AL) for now +752 026E F7 E2 MUL DX ;(DX,AX) = record * size (byte offset) +753 0270 93 XCHG AX,BX ;(DX,BX) = result +754 0271 03 DB ADD BX,BX ;Offset * 2 (for /128) +755 0273 13 D2 ADC DX,DX +756 0275 0A F6 OR DH,DH ;Test for too big +757 0277 75 C6 JNZ ercfc ; Yes +758 0279 8A F2 MOV DH,DL +759 027B 8A D7 MOV DL,BH ;(DX) = physical record number +760 027D D0 EB SHR BL,1 +761 027F 32 FF XOR BH,BH ;(BX) = offset into physical record +762 0281 EB 02 JMP SHORT rand4 +763 +764 0283 33 DB rand3: XOR BX,BX ;(BX) = 0 (offset) +765 +766 ; (DX) = physical record number +767 ; (BX) = offset into physical record +768 +769 0285 89 16 0000 R rand4: MOV [RECORD],DX ;Save record number +770 0289 8D 8C 00BC LEA CX,[SI].FR_FIELD ;(CX) = logical buffer address +771 028D 89 0E 0002 R MOV [LBUFF],CX ;Save as LBUFF +772 0291 5A POP DX ;Get record length +773 + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-13 + + + +774 ; (DX) = bytes left to transfer (initially record length) +775 ; (BX) = offset into current record +776 +777 0292 8D 4C 33 nxtopd: LEA CX,[SI].FD_BUFFER ;(CX) = physical buffer address +778 0295 03 CB ADD CX,BX ;Add in offset +779 0297 89 0E 0004 R MOV [PBUFF],CX ;Save in PBUFF +780 029B B9 0080 MOV CX,REC_LENGTH +781 029E 2B CB SUB CX,BX ;(CX) = bytes left in sector +782 02A0 3B CA CMP CX,DX ;find smaller left (buffer : record) +783 02A2 72 02 JB datmof ;(CX) = left in buffer +784 02A4 8B CA MOV CX,DX ;(CX) = left in record +785 02A6 A8 01 datmof: TEST AL,PUTFLG ;Check for read (GET) +786 02A8 74 33 JZ fivdrd ; Yes +787 +788 02AA 81 F9 0080 CMP CX,REC_LENGTH ;Writing entire sector? +789 02AE 73 03 JAE nofvrd ; Yes +790 +791 02B0 E8 02F9 R CALL GETSUB ;Read current sector +792 +793 02B3 56 nofvrd: PUSH SI ;Move logical to physical +794 02B4 51 PUSH CX +795 02B5 8B 36 0002 R MOV SI,[LBUFF] +796 02B9 8B 3E 0004 R MOV DI,[PBUFF] +797 02BD D1 E9 SHR CX,1 +798 02BF F3/ A5 REP MOVSW +799 02C1 73 01 JNC evenlp +800 02C3 A4 MOVSB +801 02C4 59 evenlp: POP CX +802 02C5 5E POP SI +803 +804 02C6 E8 02F5 R CALL PUTSUB ;Write through to current sector +805 +806 02C9 FF 06 0000 R nxfvbf: INC [RECORD] ;Bump current record number +807 02CD 01 0E 0002 R ADD [LBUFF],CX ;Bump logical buffer offset +808 02D1 2B D1 SUB DX,CX ;Subtract bytes transferred +809 02D3 33 DB XOR BX,BX ;Zero offset into buffer +810 02D5 0B D2 OR DX,DX ;Check for more to transfer +811 02D7 75 B9 JNZ nxtopd ; Yes - keep looping +812 +813 02D9 5B POP BX +814 02DA 5A POP DX +815 02DB 59 POP CX +816 02DC C3 RET +817 +818 02DD E8 02F9 R fivdrd: CALL GETSUB ;Read current record +819 +820 02E0 56 PUSH SI ;Transfer from physical to logical +821 02E1 51 PUSH CX +822 02E2 8B 36 0004 R MOV SI,[PBUFF] +823 02E6 8B 3E 0002 R MOV DI,[LBUFF] +824 02EA D1 E9 SHR CX,1 +825 02EC F3/ A5 REP MOVSW +826 02EE 73 01 JNC evenpl +827 02F0 A4 MOVSB + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-14 + + + +828 02F1 59 evenpl: POP CX +829 02F2 5E POP SI +830 02F3 EB D4 JMP nxfvbf ;Go to common code +831 +832 ; Sector I/O routines for random +833 +834 02F5 0C 04 PUTSUB: OR AL,DIRFLG ;Set write flag +835 02F7 EB 02 JMP SHORT pgsub1 +836 +837 02F9 24 FB GETSUB: AND AL,not DIRFLG ;Clear write flag (read) +838 +839 02FB 50 pgsub1: PUSH AX +840 02FC 51 PUSH CX +841 02FD 52 PUSH DX +842 02FE 53 PUSH BX +843 02FF 8B 1E 0000 R MOV BX,[RECORD] ;Get record number +844 0303 43 INC BX +845 0304 3B 9C 00B5 CMP BX,[SI].FR_PHYREC ;Check if current record in buffer +846 0308 75 04 JNE ntreds ; No +847 +848 030A A8 04 TEST AL,DIRFLG ;Check if read +849 030C 74 20 JZ pgret ; Yes - do not bother +850 +851 030E 4B ntreds: DEC BX +852 030F 89 5C 27 MOV [SI].FD_CURLOC,BX ;Set CURLOC to physical record +853 0312 C6 44 29 80 MOV [SI].FD_ORNOFS,REC_LENGTH +854 0316 C6 44 2A 80 MOV [SI].FD_NMLOFS,REC_LENGTH +855 031A 89 5C 22 MOV WORD PTR [SI].FD_FCB+FCB_RN,BX ;Set record number +856 031D C7 44 24 0000 MOV WORD PTR [SI].FD_FCB+FCB_RN+2,0 +857 +858 0322 A8 04 TEST AL,DIRFLG ;Check if read +859 0324 74 05 JZ get1 ; Yes - read +860 +861 0326 E8 035D R CALL WRITE_SECTOR ;Write it +862 0329 EB 03 JMP SHORT pgret ;Done +863 +864 032B E8 0333 R get1: CALL READ_SECTOR ;Read it +865 +866 032E 5B pgret: POP BX +867 032F 5A POP DX +868 0330 59 POP CX +869 0331 58 POP AX +870 0332 C3 RET +871 +872 +873 0333 devio_disk ENDP + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-1 + + + +874 +875 +876 ; Utility routines for disk I/O +877 +878 +879 0333 locals PROC NEAR +880 +881 +882 0333 READ_SECTOR: +883 0333 FF 44 27 INC [SI].FD_CURLOC ;Bump logical record number +884 +885 0336 51 PUSH CX +886 0337 57 PUSH DI +887 0338 B9 0040 MOV CX,REC_LENGTH/2 +888 033B 33 C0 XOR AX,AX +889 033D 8D 7C 33 LEA DI,[SI].FD_BUFFER +890 0340 F3/ AB REP STOSW ;Clear buffer +891 0342 5F POP DI +892 0343 59 POP CX +893 +894 0344 E8 038B R CALL SETBUF ;Set buffer address +895 0347 B4 21 MOV AH,C_RNDR +896 0349 E8 0397 R CALL ACCFIL ;Read random +897 034C 0A C0 OR AL,AL +898 034E B0 00 MOV AL,0 ;Length = 0 for end of file +899 0350 75 02 JNZ read1 +900 +901 0352 B0 80 MOV AL,REC_LENGTH ;Length = sector size +902 +903 0354 88 44 29 read1: MOV [SI].FD_ORNOFS,AL ;Set number bytes read +904 0357 88 44 2A MOV [SI].FD_NMLOFS,AL ;Set number of bytes left +905 035A 0A C0 OR AL,AL ;'Z' set if end of file +906 035C C3 RET +907 +908 +909 +910 035D WRITE_SECTOR: +911 035D C6 44 29 00 MOV [SI].FD_ORNOFS,0 ;Clear offset into buffer +912 0361 E8 038B R CALL SETBUF ;Set buffer address +913 0364 B4 22 MOV AH,C_RNDW +914 0366 E8 0397 R CALL ACCFIL ;Random write +915 0369 3C FF CMP AL,255 +916 036B 74 18 JE erctmf ;Too many files +917 036D FE C8 DEC AL +918 036F 74 17 JZ ercioe ;Error estending file +919 0371 FE C8 DEC AL +920 0373 75 0C JNZ write1 +921 +922 0375 88 04 MOV [SI].FD_MODE,AL ;Clear mode - disk full +923 0377 8D 54 01 LEA DX,[SI].FD_FCB +924 CALLOS C_CLOS ;Close file +925 037A B4 10 + MOV AH,C_CLOS +926 037C CD 21 + INT 33 +927 037E E9 0000 E JMP $ERC_DFL ;Disk full error + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-2 + + + +928 +929 0381 FF 44 27 write1: INC [SI].FD_CURLOC ;Bump current location +930 0384 C3 RET +931 +932 0385 E9 0000 E erctmf: JMP $ERC_TMF +933 +934 0388 E9 0000 E ercioe: JMP $ERC_IOE +935 +936 +937 +938 038B 51 SETBUF: PUSH CX ;Set buffer address +939 038C 52 PUSH DX +940 038D 8D 54 33 LEA DX,[SI].FD_BUFFER +941 CALLOS C_BUFF +942 0390 B4 1A + MOV AH,C_BUFF +943 0392 CD 21 + INT 33 +944 0394 5A POP DX +945 0395 59 POP CX +946 0396 C3 RET +947 +948 +949 +950 0397 51 ACCFIL: PUSH CX ;Access file +951 0398 52 PUSH DX +952 0399 8D 54 01 LEA DX,[SI].FD_FCB +953 CALLOS ;Call operating system +954 039C CD 21 + INT 33 +955 039E FF 44 22 INC WORD PTR [SI].FD_FCB+FCB_RN ;Bump record number +956 03A1 75 03 JNZ accfl1 +957 03A3 FF 44 24 INC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Bump high order bytes +958 03A6 80 FC 22 accfl1: CMP AH,C_RNDW +959 03A9 75 12 JNE accfl2 +960 03AB 0A C0 OR AL,AL +961 03AD 74 14 JZ accret ;No error +962 03AF 3C 05 CMP AL,5 +963 03B1 74 D2 JE erctmf ;5 - Too many files +964 03B3 3C 03 CMP AL,3 +965 03B5 B0 01 MOV AL,1 ;Map 3 to 1 +966 03B7 74 0A JE accret +967 03B9 FE C0 INC AL ;Disk space full +968 03BB EB 06 JMP SHORT accret +969 +970 03BD accfl2: +971 if _MSDOS_ +972 03BD 3C 03 CMP AL,3 ;Test for partial sector read +973 03BF 75 02 JNE accret +974 03C1 32 C0 XOR AL,AL ;Map 3 to 0 (no error) +975 endif +976 03C3 5A accret: POP DX +977 03C4 59 POP CX +978 03C5 C3 RET +979 +980 +981 + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-3 + + + +982 03C6 50 NAMFIL: PUSH AX +983 03C7 51 PUSH CX +984 03C8 56 PUSH SI +985 03C9 8B 0F MOV CX,[BX] ;(CX) = string length +986 03CB 8B 77 02 MOV SI,[BX+2] ;(SI) = string address +987 03CE E8 0000 E CALL $SCANF ;Scan file name +988 03D1 A8 80 TEST AL,80h ;Check for special devices +989 03D3 78 07 JS ercbfn ;Illegal device name (only disk) +990 03D5 E8 0000 E CALL $$DITS ;Delete temporary strings +991 03D8 5E POP SI +992 03D9 59 POP CX +993 03DA 58 POP AX +994 03DB C3 RET +995 +996 03DC E9 0000 E ercbfn: JMP $ERC_BFN +997 +998 +999 +1000 if _MSDOS_ +1001 ;** CHKFOP - Check for file already open +1002 ; +1003 ; ENTRY (SI) = file data block pointer +1004 ; USES AX +1005 +1006 03DF 57 CHKFOP: PUSH DI +1007 03E0 80 7C 01 00 CMP [SI].FD_FCB,0 ;Default drive? +1008 03E4 75 09 JNE ntcdrv ; No +1009 +1010 CALLOS C_GDRV ;Get drive number +1011 03E6 B4 19 + MOV AH,C_GDRV +1012 03E8 CD 21 + INT 33 +1013 03EA FE C0 INC AL ; Convert to A=1, etc. +1014 03EC 88 44 01 MOV [SI].FD_FCB,AL ;Save drive number +1015 +1016 03EF BF 0002 E ntcdrv: MOV DI,OFFSET DC:$FILPT-BL_LNK ;Must link through open file list +1017 +1018 03F2 8B 7D FE chklop: MOV DI,[DI].BL_LNK ;Chain to next entry +1019 03F5 0B FF OR DI,DI ;Test for end of list +1020 03F7 74 14 JE chkret ; Done +1021 +1022 03F9 3B F7 CMP SI,DI ;Same file? +1023 03FB 74 F5 JE chklop ; Yes - skip this one +1024 +1025 03FD 56 PUSH SI +1026 03FE 57 PUSH DI +1027 03FF 46 INC SI ;Point to FCB's +1028 0400 47 INC DI +1029 0401 B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive +1030 0404 F3/ A6 REPZ CMPSB ;Compare strings +1031 0406 5F POP DI +1032 0407 5E POP SI +1033 0408 75 E8 JNE chklop ;Not equal - keep going +1034 +1035 040A E9 0000 E JMP $ERC_FAO ;File already open + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-4 + + + +1036 +1037 040D 5F chkret: POP DI +1038 040E C3 RET +1039 endif +1040 +1041 +1042 040F locals ENDP + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-1 + + + +1043 +1044 +1045 ; Compiler Generated Library Calls +1046 +1047 040F entries PROC NEAR +1048 +1049 +1050 ;** $FL0 and $FIL - FILES statement +1051 +1052 ;** $FL0 +1053 ; +1054 ; ENTRY NONE +1055 ; EXIT NONE +1056 +1057 040F E8 0000 E $FL0: CALL $SAVREG +1058 0412 BB 0000 E MOV BX,OFFSET DC:$FILNAM +1059 0415 C6 07 00 MOV BYTE PTR [BX],0 ;Select default drive +1060 0418 43 INC BX +1061 0419 B1 0B MOV CL,11 +1062 041B E8 050D R CALL FILQST ;Fill name with ? +1063 041E EB 06 JMP SHORT fil01 ;Go to common code +1064 +1065 +1066 ;** $FIL +1067 ; +1068 ; ENTRY (BX) = filename sdesc +1069 ; USES NONE +1070 +1071 0420 E8 0000 E $FIL: CALL $SAVREG +1072 0423 E8 03C6 R CALL NAMFIL ;Scan file name +1073 0426 fil01: +1074 0426 C6 06 000C E 00 MOV BYTE PTR [$FILNAM+12],0 ;Clear extent byte +1075 042B BB 0001 E MOV BX,OFFSET DC:$FILNAM+1 ;Point to filename +1076 042E B1 08 MOV CL,8 +1077 0430 E8 0508 R CALL FILQS +1078 0433 BB 0009 E MOV BX,OFFSET DC:$FILNAM+9 ;Point to extension +1079 0436 B1 03 MOV CL,3 +1080 0438 E8 0508 R CALL FILQS +1081 if _MSDOS_ +1082 043B BA 0000 E MOV DX,OFFSET DC:$FILNM2 ;For MSDOS +1083 else +1084 MOV DX,OFFSET DC:$DIRTMP ;For CPM +1085 endif +1086 CALLOS C_BUFF ;Set buffer address +1087 043E B4 1A + MOV AH,C_BUFF +1088 0440 CD 21 + INT 33 +1089 0442 BA 0000 E MOV DX,OFFSET DC:$FILNAM +1090 CALLOS C_SEAR ;Search for filename +1091 0445 B4 11 + MOV AH,C_SEAR +1092 0447 CD 21 + INT 33 +1093 0449 3C FF CMP AL,255 ;Test for 1st occurence of file +1094 044B 74 63 JZ ercfnf ; Not found +1095 +1096 044D BE 0001 E filnxt: MOV SI,OFFSET DC:$FILNM2+1 ;Point to file name + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-2 + + + +1097 0450 B9 000B MOV CX,11 ;Characters in name +1098 +1099 0453 AC mornam: LODSB ;Get character +1100 0454 E8 0000 E CALL $$WCHT ;Output it +1101 0457 83 F9 04 CMP CX,4 +1102 045A 75 0B JNE notext ;Not an extension break +1103 +1104 045C 8A 04 MOV AL,[SI] ;Get 1st char of extension +1105 045E 3C 20 CMP AL,' ' +1106 0460 74 02 JE prispa ;Blank extension - print space +1107 +1108 0462 B0 2E MOV AL,'.' ;Print . +1109 +1110 0464 E8 0000 E prispa: CALL $$WCHT ;Print blank or dot +1111 +1112 0467 E2 EA notext: LOOP mornam ;Loop until 11 characters +1113 +1114 0469 E8 0000 E CALL $TTY_GPOS ;Get TTY position +1115 046C 86 C4 XCHG AL,AH +1116 046E 04 0E ADD AL,14-_IBM_ ;Position after next file name +1117 0470 E8 0000 E CALL $TTY_GWID ;Get TTY width +1118 0473 3A C4 CMP AL,AH +1119 0475 73 0A JAE nwfiln ;Force CR/LF +1120 +1121 0477 B0 20 MOV AL,' ' +1122 ife _IBM_ +1123 0479 E8 0000 E CALL $$WCHT +1124 endif +1125 047C E8 0000 E CALL $$WCHT +1126 047F EB 03 JMP SHORT nextfl +1127 +1128 0481 E8 0000 E nwfiln: CALL $$TCR ;Type CR/LF +1129 +1130 0484 BA 0000 E nextfl: MOV DX,OFFSET DC:$FILNAM +1131 CALLOS C_SEAR+1 +1132 0487 B4 12 + MOV AH,C_SEAR+1 +1133 0489 CD 21 + INT 33 +1134 048B 3C FF CMP AL,255 +1135 048D 75 BE JNE filnxt ;Still more +1136 +1137 048F C3 nwfil2: RET +1138 +1139 +1140 +1141 ;** $DKK - KILL filename +1142 ; +1143 ; ENTRY (BX) = filename sdesc +1144 ; USES NONE +1145 +1146 0490 E8 0000 E $DKK: CALL $SAVREG +1147 0493 E8 03C6 R CALL NAMFIL ;Scan file name +1148 if _CPM_ +1149 MOV DX,OFFSET DC:$DIRTMP ;Temporary buffer +1150 CALLOS C_BUFF ;Set buffer address + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-3 + + + +1151 endif +1152 0496 BA 0000 E MOV DX,OFFSET DC:$FILNAM +1153 CALLOS C_OPEN ;Open file +1154 0499 B4 0F + MOV AH,C_OPEN +1155 049B CD 21 + INT 33 +1156 049D FE C0 INC AL +1157 049F 74 0F JZ ercfnf ;File not found +1158 CALLOS C_CLOS ;Close file +1159 04A1 B4 10 + MOV AH,C_CLOS +1160 04A3 CD 21 + INT 33 +1161 if _MSDOS_ +1162 04A5 BE FFFF E MOV SI,OFFSET DC:$FILNAM-1 ;Pretend we are FDB +1163 04A8 E8 03DF R CALL CHKFOP ;Check for conflict with open files +1164 endif +1165 CALLOS C_DELE ;Delete file +1166 04AB B4 13 + MOV AH,C_DELE +1167 04AD CD 21 + INT 33 +1168 04AF C3 RET +1169 +1170 04B0 E9 0000 E ercfnf: JMP $ERC_FNF ;File not found +1171 +1172 +1173 +1174 ;** $DKR - NAME statement +1175 ; +1176 ; ENTRY (BX) = source name +1177 ; (DX) = dest name +1178 ; EXIT NONE +1179 +1180 04B3 E8 0000 E $DKR: CALL $SAVREG +1181 04B6 52 PUSH DX ;Save dest name +1182 04B7 E8 03C6 R CALL NAMFIL ;Scan old file name +1183 04BA BA 0000 E MOV DX,OFFSET DC:$FILNAM +1184 CALLOS C_OPEN +1185 04BD B4 0F + MOV AH,C_OPEN +1186 04BF CD 21 + INT 33 +1187 04C1 FE C0 INC AL +1188 04C3 74 EB JZ ercfnf ;File not found +1189 04C5 8B F2 MOV SI,DX +1190 04C7 BF 0000 E MOV DI,OFFSET DC:$FILNM2 +1191 04CA B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive +1192 04CD F3/ A4 REP MOVSB ;Move name +1193 04CF 5B POP BX ;Pop dest name +1194 04D0 E8 03C6 R CALL NAMFIL ;Scan new filename +1195 CALLOS C_OPEN +1196 04D3 B4 0F + MOV AH,C_OPEN +1197 04D5 CD 21 + INT 33 +1198 04D7 FE C0 INC AL +1199 04D9 75 13 JNZ ercfae ;File already exists +1200 +1201 ;if _CPM_ +1202 ; MOV AL,[$FILNAM] ;Test to see if drives match +1203 ; CMP [$FILNM2],AL +1204 ; JE drvsok + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-4 + + + +1205 ; JMP $ERC_FC ;Illegal function call +1206 ;drvsok: +1207 ;endif +1208 +1209 if _MSDOS_ +1210 04DB 8B F2 MOV SI,DX +1211 04DD 46 INC SI ;(SI) = $FILNAM+1 +1212 04DE BF 0011 E MOV DI,OFFSET DC:$FILNM2+17 ;(DI) = dest for new file name +1213 04E1 B9 000B MOV CX,FILNAM_LENGTH ;No drive code +1214 04E4 F3/ A4 REP MOVSB ;Move name +1215 endif +1216 +1217 04E6 BA 0000 E MOV DX,OFFSET DC:$FILNM2 ;Point to 2nd FCB +1218 CALLOS C_RENA ;Rename file +1219 04E9 B4 17 + MOV AH,C_RENA +1220 04EB CD 21 + INT 33 +1221 04ED C3 RET +1222 +1223 04EE E9 0000 E ercfae: JMP $ERC_FAE ;File already exists +1224 +1225 +1226 +1227 ;** $RS2 - RESET statement; +1228 ; +1229 ; ENTRY NONE +1230 ; EXIT NONE +1231 +1232 04F1 $ZZ1: +1233 04F1 E8 0000 E $RS2: CALL $SAVREG +1234 04F4 E8 0000 E CALL $CLOSF ;Close all files +1235 CALLOS C_GDRV ;Get drive number +1236 04F7 B4 19 + MOV AH,C_GDRV +1237 04F9 CD 21 + INT 33 +1238 04FB 50 PUSH AX +1239 CALLOS C_REST ;Restore +1240 04FC B4 0D + MOV AH,C_REST +1241 04FE CD 21 + INT 33 +1242 0500 58 POP AX +1243 0501 8A D0 MOV DL,AL +1244 CALLOS C_SDRV ;Set drive number +1245 0503 B4 0E + MOV AH,C_SDRV +1246 0505 CD 21 + INT 33 +1247 0507 C3 RET +1248 +1249 +1250 0508 entries ENDP +1251 +1252 0508 filprc PROC NEAR +1253 +1254 0508 80 3F 2A filqs: CMP BYTE PTR [BX],'*' ;Test for * +1255 050B 75 08 JNE filret +1256 +1257 050D C6 07 3F filqst: MOV BYTE PTR [BX],'?' ;Fill with ? +1258 0510 43 INC BX + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-5 + + + +1259 0511 FE C9 DEC CL +1260 0513 75 F8 JNZ filqst ;Keep looping +1261 +1262 0515 C3 filret: RET +1263 +1264 0516 filprc ENDP +1265 +1266 0516 CODE ENDS +1267 +1268 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +CALLOS . . . . . . . . . . . . . 0002 +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0516 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0006 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ACCFIL . . . . . . . . . . . . . L NEAR 0397 CODE +ACCFL1 . . . . . . . . . . . . . L NEAR 03A6 CODE +ACCFL2 . . . . . . . . . . . . . L NEAR 03BD CODE +ACCRET . . . . . . . . . . . . . L NEAR 03C3 CODE +APPFIN . . . . . . . . . . . . . L NEAR 01DC CODE +BAKRET . . . . . . . . . . . . . L NEAR 023E CODE +BAKURN . . . . . . . . . . . . . L NEAR 0235 CODE + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Symbols-2 + + + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +CHKCTZ . . . . . . . . . . . . . L NEAR 0059 CODE +CHKFOP . . . . . . . . . . . . . L NEAR 03DF CODE +CHKLOP . . . . . . . . . . . . . L NEAR 03F2 CODE +CHKRET . . . . . . . . . . . . . L NEAR 040D CODE +CR . . . . . . . . . . . . . . . Number 000D +C_BUFF . . . . . . . . . . . . . Number 001A +C_CLOS . . . . . . . . . . . . . Number 0010 +C_DELE . . . . . . . . . . . . . Number 0013 +C_GDRV . . . . . . . . . . . . . Number 0019 +C_MAKE . . . . . . . . . . . . . Number 0016 +C_OPEN . . . . . . . . . . . . . Number 000F +C_READ . . . . . . . . . . . . . Number 0014 +C_RENA . . . . . . . . . . . . . Number 0017 +C_REST . . . . . . . . . . . . . Number 000D +C_RNDR . . . . . . . . . . . . . Number 0021 +C_RNDW . . . . . . . . . . . . . Number 0022 +C_SDRV . . . . . . . . . . . . . Number 000E +C_SEAR . . . . . . . . . . . . . Number 0011 +C_WRIT . . . . . . . . . . . . . Number 0015 +DATMOF . . . . . . . . . . . . . L NEAR 02A6 CODE +DEVIO_DISK . . . . . . . . . . . N PROC 0018 CODE Length =031B +DIRFLG . . . . . . . . . . . . . Number 0004 +DISK_BAKC. . . . . . . . . . . . L NEAR 009B CODE +DISK_CLOSE . . . . . . . . . . . L NEAR 0018 CODE +DISK_EOF . . . . . . . . . . . . L NEAR 003D CODE +DISK_GPOS. . . . . . . . . . . . L NEAR 009F CODE +DISK_GWID. . . . . . . . . . . . L NEAR 00A3 CODE +DISK_LOC . . . . . . . . . . . . L NEAR 006D CODE +DISK_LOF . . . . . . . . . . . . L NEAR 007A CODE +DISK_OPEN. . . . . . . . . . . . L NEAR 0145 CODE +DISK_POS . . . . . . . . . . . . L NEAR 0091 CODE +DISK_RANDIO. . . . . . . . . . . L NEAR 0245 CODE +DISK_SINP. . . . . . . . . . . . L NEAR 00D7 CODE +DISK_SINPB . . . . . . . . . . . L NEAR 00A7 CODE +DISK_SOUT. . . . . . . . . . . . L NEAR 0109 CODE +DISK_WIDTH . . . . . . . . . . . L NEAR 0097 CODE +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Symbols-3 + + + +DV_WIDTH . . . . . . . . . . . . Number 0008 +ENTRIES. . . . . . . . . . . . . N PROC 040F CODE Length =00F9 +EOFCHR . . . . . . . . . . . . . Number 001A +EOFRET . . . . . . . . . . . . . L NEAR 0069 CODE +ERCBFM . . . . . . . . . . . . . L NEAR 006A CODE +ERCBFN . . . . . . . . . . . . . L NEAR 03DC CODE +ERCBRN . . . . . . . . . . . . . L NEAR 0242 CODE +ERCFAE . . . . . . . . . . . . . L NEAR 04EE CODE +ERCFC. . . . . . . . . . . . . . L NEAR 023F CODE +ERCFNF . . . . . . . . . . . . . L NEAR 04B0 CODE +ERCFOV . . . . . . . . . . . . . L NEAR 0106 CODE +ERCIOE . . . . . . . . . . . . . L NEAR 0388 CODE +ERCTMF . . . . . . . . . . . . . L NEAR 0385 CODE +EVENLP . . . . . . . . . . . . . L NEAR 02C4 CODE +EVENPL . . . . . . . . . . . . . L NEAR 02F1 CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_EX . . . . . . . . . . . . . Number 000C +FCB_FN . . . . . . . . . . . . . Number 0001 +FCB_FSIZ . . . . . . . . . . . . Number 0010 +FCB_FT . . . . . . . . . . . . . Number 0009 +FCB_LENGTH . . . . . . . . . . . Number 0026 +FCB_NR . . . . . . . . . . . . . Number 0020 +FCB_RC . . . . . . . . . . . . . Number 000F +FCB_RN . . . . . . . . . . . . . Number 0021 +FCB_RSIZ . . . . . . . . . . . . Number 000E +FIL01. . . . . . . . . . . . . . L NEAR 0426 CODE +FILLS1 . . . . . . . . . . . . . L NEAR 00D3 CODE +FILLSQ . . . . . . . . . . . . . L NEAR 00C8 CODE +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +FILNXT . . . . . . . . . . . . . L NEAR 044D CODE +FILPRC . . . . . . . . . . . . . N PROC 0508 CODE Length =000E +FILQS. . . . . . . . . . . . . . L NEAR 0508 CODE +FILQST . . . . . . . . . . . . . L NEAR 050D CODE +FILRET . . . . . . . . . . . . . L NEAR 0515 CODE +FIVDRD . . . . . . . . . . . . . L NEAR 02DD CODE +FOVCHK . . . . . . . . . . . . . L NEAR 00F6 CODE +GET1 . . . . . . . . . . . . . . L NEAR 032B CODE +GETSUB . . . . . . . . . . . . . L NEAR 02F9 CODE +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LBUFF. . . . . . . . . . . . . . L WORD 0002 DATA +LOC1 . . . . . . . . . . . . . . L NEAR 0079 CODE +LOCALS . . . . . . . . . . . . . N PROC 0333 CODE Length =00DC +MAKFIL . . . . . . . . . . . . . L NEAR 0192 CODE +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +MORNAM . . . . . . . . . . . . . L NEAR 0453 CODE + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Symbols-4 + + + +NAMFIL . . . . . . . . . . . . . L NEAR 03C6 CODE +NEXTFL . . . . . . . . . . . . . L NEAR 0484 CODE +NOCHK. . . . . . . . . . . . . . L NEAR 0181 CODE +NOFORC . . . . . . . . . . . . . L NEAR 002B CODE +NOFVRD . . . . . . . . . . . . . L NEAR 02B3 CODE +NOMTRC . . . . . . . . . . . . . L NEAR 020C CODE +NOTEXT . . . . . . . . . . . . . L NEAR 0467 CODE +NOTRND . . . . . . . . . . . . . L NEAR 0155 CODE +NTAPNF . . . . . . . . . . . . . L NEAR 01B3 CODE +NTCDRV . . . . . . . . . . . . . L NEAR 03EF CODE +NTREDS . . . . . . . . . . . . . L NEAR 030E CODE +NTZRFL . . . . . . . . . . . . . L NEAR 01ED CODE +NWFIL2 . . . . . . . . . . . . . L NEAR 048F CODE +NWFILN . . . . . . . . . . . . . L NEAR 0481 CODE +NXFVBF . . . . . . . . . . . . . L NEAR 02C9 CODE +NXTOPD . . . . . . . . . . . . . L NEAR 0292 CODE +OPNFIL . . . . . . . . . . . . . L NEAR 019D CODE +OPNRET . . . . . . . . . . . . . L NEAR 01D9 CODE +OPNSET . . . . . . . . . . . . . L NEAR 01BD CODE +ORNCHK . . . . . . . . . . . . . L NEAR 0042 CODE +PBUFF. . . . . . . . . . . . . . L WORD 0004 DATA +PGRET. . . . . . . . . . . . . . L NEAR 032E CODE +PGSUB1 . . . . . . . . . . . . . L NEAR 02FB CODE +PRISPA . . . . . . . . . . . . . L NEAR 0464 CODE +PUTFLG . . . . . . . . . . . . . Number 0001 +PUTSUB . . . . . . . . . . . . . L NEAR 02F5 CODE +RAND1. . . . . . . . . . . . . . L NEAR 0253 CODE +RAND2. . . . . . . . . . . . . . L NEAR 0257 CODE +RAND3. . . . . . . . . . . . . . L NEAR 0283 CODE +RAND4. . . . . . . . . . . . . . L NEAR 0285 CODE +READ1. . . . . . . . . . . . . . L NEAR 0354 CODE +READ_SECTOR. . . . . . . . . . . L NEAR 0333 CODE +RECORD . . . . . . . . . . . . . L WORD 0000 DATA +REC_LENGTH . . . . . . . . . . . Number 0080 +REDOEF . . . . . . . . . . . . . L NEAR 0214 CODE +RELFLG . . . . . . . . . . . . . Number 0002 +SETBUF . . . . . . . . . . . . . L NEAR 038B CODE +SETSQM . . . . . . . . . . . . . L NEAR 0220 CODE +SETSQO . . . . . . . . . . . . . L NEAR 0225 CODE +SINP1. . . . . . . . . . . . . . L NEAR 00AF CODE +SINP_50. . . . . . . . . . . . . L NEAR 00EB CODE +SINRET . . . . . . . . . . . . . L NEAR 00D6 CODE +SOUT1. . . . . . . . . . . . . . L NEAR 0111 CODE +SOUT2. . . . . . . . . . . . . . L NEAR 011C CODE +SOUT3. . . . . . . . . . . . . . L NEAR 0132 CODE +SOUTPS . . . . . . . . . . . . . L NEAR 0129 CODE +SOUT_50. . . . . . . . . . . . . L NEAR 013A CODE +WASEOF . . . . . . . . . . . . . L NEAR 0063 CODE +WRITE1 . . . . . . . . . . . . . L NEAR 0381 CODE +WRITE_SECTOR . . . . . . . . . . L NEAR 035D CODE +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$TCR. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WCHT . . . . . . . . . . . . . L NEAR 0000 CODE External + + +IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Symbols-5 + + + +$CLOSF . . . . . . . . . . . . . L NEAR 0000 CODE External +$DEVOPN. . . . . . . . . . . . . L NEAR 0000 CODE External +$DKK . . . . . . . . . . . . . . L NEAR 0490 CODE Global +$DKR . . . . . . . . . . . . . . L NEAR 04B3 CODE Global +$DNORM . . . . . . . . . . . . . L NEAR 0000 CODE External +$D_DISK. . . . . . . . . . . . . L NEAR 0000 CODE Global +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_BFN . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_BRN . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_DFL . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FAE . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FAO . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FNF . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FOV . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IOE . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_TMF . . . . . . . . . . . . L NEAR 0000 CODE External +$FBALC . . . . . . . . . . . . . L NEAR 0000 CODE External +$FBDEA . . . . . . . . . . . . . L NEAR 0000 CODE External +$FIL . . . . . . . . . . . . . . L NEAR 0420 CODE Global +$FILMOD. . . . . . . . . . . . . V BYTE 0000 DATA External +$FILNAM. . . . . . . . . . . . . V BYTE 0000 DATA External +$FILNM2. . . . . . . . . . . . . V BYTE 0000 DATA External +$FILPT . . . . . . . . . . . . . V WORD 0000 DATA External +$FL0 . . . . . . . . . . . . . . L NEAR 040F CODE Global +$RS2 . . . . . . . . . . . . . . L NEAR 04F1 CODE Global +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SCANF . . . . . . . . . . . . . L NEAR 0000 CODE External +$TTY_GPOS. . . . . . . . . . . . L NEAR 0000 CODE External +$TTY_GWID. . . . . . . . . . . . L NEAR 0000 CODE External +$ZZ1 . . . . . . . . . . . . . . L NEAR 04F1 CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___TMP . . . . . . . . . . . . . Number 0089 +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/IODISK.ASM b/3_source_code/BASLIB-86/IODISK.ASM new file mode 100644 index 0000000..eb9fd25 --- /dev/null +++ b/3_source_code/BASLIB-86/IODISK.ASM @@ -0,0 +1,1022 @@ + TITLE IODISK - Disk I/O Drivers for BASCOM-86 +PAGE 60,132 +; This module contains the disk operating system interface +; for the device I/O independent package. It also includes +; other operating system features of BASIC. + + INCLUDE TABMAC.INC + +DATA SEGMENT WORD PUBLIC 'DATA' + + INCLUDE DEVDEF.INC + + PAGE + +; Operating System Equates and Macros + + +; MSDOS/CPM Operating System Function Codes + +C_REST= 13 +C_SDRV= 14 +C_OPEN= 15 +C_CLOS= 16 +C_SEAR= 17 +C_DELE= 19 +C_READ= 20 +C_WRIT= 21 +C_MAKE= 22 +C_RENA= 23 +C_GDRV= 25 +C_BUFF= 26 +C_RNDR= 33 +C_RNDW= 34 + + +; MSDOS/CPM File Control Block Offsets + +FCB_FN= 1 +FCB_FT= 9 +FCB_EX= 12 +FCB_RSIZ= 14 ;MSDOS +FCB_RC= 15 ;MSDOS +FCB_FSIZ= 16 ;MSDOS +FCB_NR= 32 +FCB_RN= 33 + + +; MSDOS Call Macro + +if _MSDOS_ +CALLOS MACRO func +IFNB + MOV AH,func +ENDIF + INT 33 + ENDM +endif + + PAGE + +; External Data Variables + + EXTRN $FILNAM:BYTE, $FILNM2:BYTE, $FILMOD:BYTE + EXTRN $FILPT:WORD + EXTRN $$SPSV:WORD + + +; Public Data Variables + +;if _CPM_ +; PUBLIC $DIRTMP +;$DIRTMP DB REC_LENGTH DUP (?) ;Temporary buffer +;endif + + +; Local Data Variables + +RECORD DW ? ;Current record number +LBUFF DW ? ;Logical buffer address +PBUFF DW ? ;Physical buffer address + +DATA ENDS + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + +; Compiler Generated Entries + + PUBLIC $DKK,$DKR,$FL0,$FIL,$RS2,$ZZ1 + + +; Run-time entries + + PUBLIC $D_DISK + + +; Run-time externals + + EXTRN $$DITS:NEAR, $SAVREG:NEAR + EXTRN $FBALC:NEAR, $FBDEA:NEAR + EXTRN $SCANF:NEAR, $CLOSF:NEAR, $DEVOPN:NEAR + EXTRN $$WCHT:NEAR, $$TCR:NEAR + EXTRN $TTY_GPOS:NEAR, $TTY_GWID:NEAR + + EXTRN $ERC_FC:NEAR + EXTRN $ERC_BFM:NEAR + EXTRN $ERC_BFN:NEAR + EXTRN $ERC_BRN:NEAR + EXTRN $ERC_DFL:NEAR + EXTRN $ERC_FAE:NEAR + EXTRN $ERC_FAO:NEAR + EXTRN $ERC_FNF:NEAR + EXTRN $ERC_FOV:NEAR + EXTRN $ERC_IOE:NEAR + EXTRN $ERC_TMF:NEAR + +if _MSDOS_ + EXTRN $DNORM:NEAR +endif + + PAGE + +; Device Independent Disk Interface + +DSPMAC MACRO func + DW DISK_&func + ENDM + +$D_DISK: + DSPNAM + + PAGE + +devio_disk PROC NEAR + + +DISK_CLOSE: + CMP [SI].FD_MODE,MD_SQO + JNE noforc ;Don't dump buffer + + MOV AL,EOFCHR + CALL DISK_SOUT ;Write EOF character + CMP [SI].FD_ORNOFS,0 + JE noforc ;Buffer already dumped + + CALL WRITE_SECTOR ;Write sector + +noforc: PUSH CX + PUSH DX + LEA DX,[SI].FD_FCB + CALL SETBUF ;Set buffer address + CALLOS C_CLOS ;Close file + CALL $FBDEA ;Deallocate file buffer + POP DX + POP CX + RET + + + +DISK_EOF: + CMP [SI].FD_MODE,MD_SQO + JE ercbfm ;Not for output files + +ornchk: CMP [SI].FD_ORNOFS,0 + JE waseof + + XOR BX,BX + CMP [SI].FD_MODE,MD_RND + JE eofret ;Not end of file + + CMP [SI].FD_NMLOFS,BL ;(BX) is 0 + JNE chkctz ;Still characters in teh buffer + + CALL READ_SECTOR ;Read next sector + JMP ornchk + +chkctz: MOV BX,REC_LENGTH + SUB BL,[SI].FD_NMLOFS ;(BX) = character offset + CMP [SI+BX].FD_BUFFER,EOFCHR + +waseof: MOV BX,0 ;(BX) = not end of file + JNE eofret + DEC BX ;(BX) = -1 if end of file +eofret: RET + +ercbfm: JMP $ERC_BFM + +DISK_LOC: + CMP [SI].FD_MODE,MD_RND + MOV BX,[SI].FD_CURLOC ;Use CURLOC for sequential + JNE loc1 + MOV BX,[SI].FR_LOGREC ;Use LOGREC for random +loc1: RET + + + +DISK_LOF: + PUSH CX + PUSH DX + PUSH BX + MOV DX,WORD PTR [SI].FD_FCB+FCB_FSIZ ;Get length of file + MOV CX,WORD PTR [SI].FD_FCB+FCB_FSIZ+2 + XOR BX,BX + XOR DI,DI + MOV AX,(64+80h)*100h ;(AX) = (exp+128,sign) + CALL $DNORM ;Normalize as double + POP BX + POP DX + POP CX + RET + + + +DISK_POS: + XOR BX,BX + MOV BL,[SI].FD_OUTPOS ;(BX) = current file position + RET + + + +DISK_WIDTH: + MOV [SI].FD_WIDTH,DL ;Set file width + RET + + PAGE + +DISK_BAKC: + INC [SI].FD_NMLOFS ;Backup 1 character + RET + + + +DISK_GPOS: + MOV AH,[SI].FD_OUTPOS ;Get file output position + RET + + + +DISK_GWID: + MOV AH,[SI].FD_WIDTH ;Get file width + RET + + PAGE + +DISK_SINPB: + CMP [SI].FD_MODE,MD_RND + JNE sinp1 + + JMP SINP_50 ;Serial input from random + +sinp1: CMP [SI].FD_NMLOFS,0 + JE fillsq ;Sector is empty - get another + + PUSH BX + XOR BX,BX + MOV BL,[SI].FD_ORNOFS + SUB BL,[SI].FD_NMLOFS + DEC [SI].FD_NMLOFS + MOV AL,[SI+BX].FD_BUFFER ;(AL) = character + POP BX + OR AL,AL ;Clear carry + RET + +fillsq: CMP [SI].FD_ORNOFS,0 + JE fills1 ;At end of file + + CALL READ_SECTOR ;Read next sector + JNE DISK_SINP ; Not at eof - try with new buffer + +fills1: STC ;Set carry + MOV AL,EOFCHR ;Return EOF character + +sinret: RET + +DISK_SINP: + CALL DISK_SINPB ;Read binary character + JC sinret ; End of file + + CMP AL,EOFCHR ;End of file character? + CLC ;Assume not + JNE sinret ; Return + + MOV [SI].FD_ORNOFS,0 ;Clear these offsets + MOV [SI].FD_NMLOFS,0 + STC + RET + +SINP_50: ;Serial input from random file + PUSH BX + CALL FOVCHK ;Field overflow check + MOV AL,[SI+BX-1].FR_FIELD ;Get character + CLC ;Clear carry + POP BX + RET + + +FOVCHK: MOV BX,[SI].FR_OUTPOS ;Get current position + CMP BX,[SI].FR_VRECL ;Check for end of record + JE ercfov ; Yes - field overflow + INC BX ;Bump pointer + MOV [SI].FR_OUTPOS,BX ;Save new position + RET + +ercfov: JMP $ERC_FOV + + PAGE + +CR= 13 + +DISK_SOUT: + CMP [SI].FD_MODE,MD_RND + JNE sout1 + + JMP SOUT_50 ;Serial output to random + +sout1: CMP [SI].FD_ORNOFS,REC_LENGTH + JNE sout2 ;Not at end of sector + + PUSH AX + CALL WRITE_SECTOR ;Write previous sector + POP AX + +sout2: PUSH BX + XOR BX,BX + MOV BL,[SI].FD_ORNOFS ;(BX) = buffer offset + MOV [SI+BX].FD_BUFFER,AL ;Stuff character + POP BX + INC [SI].FD_ORNOFS + +soutps: CMP AL,CR + JNE sout3 + + MOV [SI].FD_OUTPOS,0 ;Zero position + RET + +sout3: CMP AL,' ' + CMC + ADC [SI].FD_OUTPOS,0 ;Add 1 if printing character + RET + +SOUT_50: ;Serial output to random file + PUSH BX + CALL FOVCHK ;Check for field overflow + MOV [SI+BX-1].FR_FIELD,AL ;Store character + POP BX + JMP soutps ;Update position + + PAGE + +DISK_OPEN: + PUSH DX + PUSH CX + + CMP [$FILMOD],MD_RND ;See if random + JNE notrnd ; No + OR CX,CX ;See if default record size + JNE notrnd ; No + MOV CX,REC_LENGTH ;Use record length as default +notrnd: PUSH CX ;Save it for now +___TMP= FR_FIELD-FD_BUFFER ;Size beyond basic FDB + ADD CX,___TMP + MOV DX,255 ;(DH,DL) = position,width + MOV AH,255 ;(AH) = all file modes legal + CALL $DEVOPN ;Allocate file block, etc. + POP CX ;Get it back + MOV [SI].FR_VRECL,CX ;Set random record length + PUSH SI + LEA DI,[SI].FD_FCB + MOV SI,OFFSET DC:$FILNAM + MOV CX,FILNAM_LENGTH+1 ;+1 for drive + REP MOVSB ;Move in name into file block + POP SI + CALL SETBUF ;Set buffer address + +if _MSDOS_ + CMP [$FILMOD],MD_APP + JNE nochk + CALL CHKFOP ;See if open +nochk: +endif + + LEA DX,[SI].FD_FCB ;(DX) = FCB address + CMP [$FILMOD],MD_SQO + JNE opnfil ;Not sequential output + +if _MSDOS_ + CALL CHKFOP ;Check if already open +endif + + CALLOS C_DELE ;Delete existing file + +makfil: CALLOS C_MAKE ;Create new file + INC AL + JNZ opnset ;Continue with OPEN + JMP erctmf ;Directory full + +opnfil: CALLOS C_OPEN ;Open existing file + INC AL + JNE opnset ;Continue with OPEN + +if _MSDOS_ + CMP [$FILMOD],MD_APP + JNE ntapnf + + MOV [$FILMOD],MD_SQO ;Default to sequential output + JMP makfil +ntapnf: +endif + + CMP [$FILMOD],MD_RND + JE makfil ;Create file for random + JMP ercfnf + +opnset: MOV AL,[$FILMOD] + MOV [SI].FD_MODE,AL ;Everything is OK - set file mode + +if _MSDOS_ + MOV WORD PTR [SI].FD_FCB+FCB_RSIZ,REC_LENGTH +endif + + CMP [SI].FD_MODE,MD_RND + JE opnret ;Done if random + +if _MSDOS_ + CMP [SI].FD_MODE,MD_APP + JE appfin ;Special if append +endif + + CMP [SI].FD_MODE,MD_SQI + JNE opnret ;Done if not input + + CALL READ_SECTOR ;Read 1st sector + +opnret: POP CX + POP DX + RET + +if _MSDOS_ + +appfin: ;Special code to find end of file + + CMP WORD PTR [SI].FD_FCB+FCB_FSIZ,0 ;Test for empty file + JNE ntzrfl + CMP WORD PTR [SI].FD_FCB+FCB_FSIZ+2,0 + JNE ntzrfl + + MOV [SI].FD_MODE,MD_SQO ;Set mode to output + JMP opnret ; and return + +ntzrfl: LEA DI,[SI].FD_FCB+FCB_RN ;Point to random record number + PUSH SI + ADD SI,FD_FCB+FCB_FSIZ ;Point to file size + TEST BYTE PTR [SI],127 ;See if multiple of 128 + PUSHF ; Save flags + LODSB ;Get low order byte of file size + SAL AL,1 ;Rotate high bit into carry + LODSW ;Get middle word + SAL AX,1 ;Rotate carry in and high bit out + STOSW ;Save low word of file size + LODSB ;Get high order byte + MOV AH,0 ;Clear high byte of record number + SAL AX,1 ;Rotate carry in + STOSW ;Save high word of record number + POPF ;Restore flags + POP SI ;Restore pointer to file data block + JNZ nomtrc ;Record is not empty + + CALL BAKURN ;Backup record number + +nomtrc: CALL READ_SECTOR ;Read record + CALL BAKURN ;Backup record number + XOR DX,DX ;Number of characters in buffer + +redoef: CALL DISK_SINPB ;Read binary character + JC setsqm ; Hit physical EOF + + CMP AL,EOFCHR + JE setsqo ;Found end of file + + INC DX + JMP redoef ;Keep looping + +setsqm: XOR DX,DX ;Start of record + CALL BAKURN ;Read 1 past + +setsqo: MOV [SI].FD_MODE,MD_SQO ;Ready for sequential output now + LEA DI,[SI].FD_CURLOC ;Point to current location + XOR AX,AX + STOSW ;Clear current location + MOV [DI],DL ;Set number of bytes in buffer + MOV [SI].FD_OUTPOS,AL ;Clear print position + JMP opnret ;Done with append + +BAKURN: SUB WORD PTR [SI].FD_FCB+FCB_RN,1 ;Decrement random record number + JAE bakret ;Done - no underflow + DEC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Decrement high word +bakret: RET + +endif + + PAGE + +PUTFLG= 1 ;on = PUT , off = GET +RELFLG= 2 ;on = relative , off = sequential +DIRFLG= 4 ;on = WRITE , off = READ + +ercfc: JMP $ERC_FC +ercbrn: JMP $ERC_BRN + +DISK_RANDIO: + PUSH CX + PUSH DX + PUSH BX + TEST AL,RELFLG ;Check for relative record number + JNZ rand1 + + MOV DX,[SI].FR_LOGREC ;(DX) = current logical record + INC DX ;Bump by 1 + JMP SHORT rand2 + +rand1: OR DX,DX ;Check for bad record number + JLE ercbrn ; Error - 0 or negative + +rand2: MOV [SI].FR_LOGREC,DX ;Save next record number + DEC DX ;(DX) = current logical record number + MOV [SI].FR_OUTPOS,0 ;Clear output position + MOV BX,[SI].FR_VRECL ;(BX) = logical record length + PUSH BX + CMP BX,REC_LENGTH ;Check if logical size = physical + JE rand3 + + XCHG AX,BX ;Save (AL) for now + MUL DX ;(DX,AX) = record * size (byte offset) + XCHG AX,BX ;(DX,BX) = result + ADD BX,BX ;Offset * 2 (for /128) + ADC DX,DX + OR DH,DH ;Test for too big + JNZ ercfc ; Yes + MOV DH,DL + MOV DL,BH ;(DX) = physical record number + SHR BL,1 + XOR BH,BH ;(BX) = offset into physical record + JMP SHORT rand4 + +rand3: XOR BX,BX ;(BX) = 0 (offset) + +; (DX) = physical record number +; (BX) = offset into physical record + +rand4: MOV [RECORD],DX ;Save record number + LEA CX,[SI].FR_FIELD ;(CX) = logical buffer address + MOV [LBUFF],CX ;Save as LBUFF + POP DX ;Get record length + +; (DX) = bytes left to transfer (initially record length) +; (BX) = offset into current record + +nxtopd: LEA CX,[SI].FD_BUFFER ;(CX) = physical buffer address + ADD CX,BX ;Add in offset + MOV [PBUFF],CX ;Save in PBUFF + MOV CX,REC_LENGTH + SUB CX,BX ;(CX) = bytes left in sector + CMP CX,DX ;find smaller left (buffer : record) + JB datmof ;(CX) = left in buffer + MOV CX,DX ;(CX) = left in record +datmof: TEST AL,PUTFLG ;Check for read (GET) + JZ fivdrd ; Yes + + CMP CX,REC_LENGTH ;Writing entire sector? + JAE nofvrd ; Yes + + CALL GETSUB ;Read current sector + +nofvrd: PUSH SI ;Move logical to physical + PUSH CX + MOV SI,[LBUFF] + MOV DI,[PBUFF] + SHR CX,1 + REP MOVSW + JNC evenlp + MOVSB +evenlp: POP CX + POP SI + + CALL PUTSUB ;Write through to current sector + +nxfvbf: INC [RECORD] ;Bump current record number + ADD [LBUFF],CX ;Bump logical buffer offset + SUB DX,CX ;Subtract bytes transferred + XOR BX,BX ;Zero offset into buffer + OR DX,DX ;Check for more to transfer + JNZ nxtopd ; Yes - keep looping + + POP BX + POP DX + POP CX + RET + +fivdrd: CALL GETSUB ;Read current record + + PUSH SI ;Transfer from physical to logical + PUSH CX + MOV SI,[PBUFF] + MOV DI,[LBUFF] + SHR CX,1 + REP MOVSW + JNC evenpl + MOVSB +evenpl: POP CX + POP SI + JMP nxfvbf ;Go to common code + +; Sector I/O routines for random + +PUTSUB: OR AL,DIRFLG ;Set write flag + JMP SHORT pgsub1 + +GETSUB: AND AL,not DIRFLG ;Clear write flag (read) + +pgsub1: PUSH AX + PUSH CX + PUSH DX + PUSH BX + MOV BX,[RECORD] ;Get record number + INC BX + CMP BX,[SI].FR_PHYREC ;Check if current record in buffer + JNE ntreds ; No + + TEST AL,DIRFLG ;Check if read + JZ pgret ; Yes - do not bother + +ntreds: DEC BX + MOV [SI].FD_CURLOC,BX ;Set CURLOC to physical record + MOV [SI].FD_ORNOFS,REC_LENGTH + MOV [SI].FD_NMLOFS,REC_LENGTH + MOV WORD PTR [SI].FD_FCB+FCB_RN,BX ;Set record number + MOV WORD PTR [SI].FD_FCB+FCB_RN+2,0 + + TEST AL,DIRFLG ;Check if read + JZ get1 ; Yes - read + + CALL WRITE_SECTOR ;Write it + JMP SHORT pgret ;Done + +get1: CALL READ_SECTOR ;Read it + +pgret: POP BX + POP DX + POP CX + POP AX + RET + + +devio_disk ENDP + + +; Utility routines for disk I/O + + +locals PROC NEAR + + +READ_SECTOR: + INC [SI].FD_CURLOC ;Bump logical record number + + PUSH CX + PUSH DI + MOV CX,REC_LENGTH/2 + XOR AX,AX + LEA DI,[SI].FD_BUFFER + REP STOSW ;Clear buffer + POP DI + POP CX + + CALL SETBUF ;Set buffer address + MOV AH,C_RNDR + CALL ACCFIL ;Read random + OR AL,AL + MOV AL,0 ;Length = 0 for end of file + JNZ read1 + + MOV AL,REC_LENGTH ;Length = sector size + +read1: MOV [SI].FD_ORNOFS,AL ;Set number bytes read + MOV [SI].FD_NMLOFS,AL ;Set number of bytes left + OR AL,AL ;'Z' set if end of file + RET + + + +WRITE_SECTOR: + MOV [SI].FD_ORNOFS,0 ;Clear offset into buffer + CALL SETBUF ;Set buffer address + MOV AH,C_RNDW + CALL ACCFIL ;Random write + CMP AL,255 + JE erctmf ;Too many files + DEC AL + JZ ercioe ;Error estending file + DEC AL + JNZ write1 + + MOV [SI].FD_MODE,AL ;Clear mode - disk full + LEA DX,[SI].FD_FCB + CALLOS C_CLOS ;Close file + JMP $ERC_DFL ;Disk full error + +write1: INC [SI].FD_CURLOC ;Bump current location + RET + +erctmf: JMP $ERC_TMF + +ercioe: JMP $ERC_IOE + + + +SETBUF: PUSH CX ;Set buffer address + PUSH DX + LEA DX,[SI].FD_BUFFER + CALLOS C_BUFF + POP DX + POP CX + RET + + + +ACCFIL: PUSH CX ;Access file + PUSH DX + LEA DX,[SI].FD_FCB + CALLOS ;Call operating system + INC WORD PTR [SI].FD_FCB+FCB_RN ;Bump record number + JNZ accfl1 + INC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Bump high order bytes +accfl1: CMP AH,C_RNDW + JNE accfl2 + OR AL,AL + JZ accret ;No error + CMP AL,5 + JE erctmf ;5 - Too many files + CMP AL,3 + MOV AL,1 ;Map 3 to 1 + JE accret + INC AL ;Disk space full + JMP SHORT accret + +accfl2: +if _MSDOS_ + CMP AL,3 ;Test for partial sector read + JNE accret + XOR AL,AL ;Map 3 to 0 (no error) +endif +accret: POP DX + POP CX + RET + + + +NAMFIL: PUSH AX + PUSH CX + PUSH SI + MOV CX,[BX] ;(CX) = string length + MOV SI,[BX+2] ;(SI) = string address + CALL $SCANF ;Scan file name + TEST AL,80h ;Check for special devices + JS ercbfn ;Illegal device name (only disk) + CALL $$DITS ;Delete temporary strings + POP SI + POP CX + POP AX + RET + +ercbfn: JMP $ERC_BFN + + + +if _MSDOS_ +;** CHKFOP - Check for file already open +; +; ENTRY (SI) = file data block pointer +; USES AX + +CHKFOP: PUSH DI + CMP [SI].FD_FCB,0 ;Default drive? + JNE ntcdrv ; No + + CALLOS C_GDRV ;Get drive number + INC AL ; Convert to A=1, etc. + MOV [SI].FD_FCB,AL ;Save drive number + +ntcdrv: MOV DI,OFFSET DC:$FILPT-BL_LNK ;Must link through open file list + +chklop: MOV DI,[DI].BL_LNK ;Chain to next entry + OR DI,DI ;Test for end of list + JE chkret ; Done + + CMP SI,DI ;Same file? + JE chklop ; Yes - skip this one + + PUSH SI + PUSH DI + INC SI ;Point to FCB's + INC DI + MOV CX,FILNAM_LENGTH+1 ;+1 for drive + REPZ CMPSB ;Compare strings + POP DI + POP SI + JNE chklop ;Not equal - keep going + + JMP $ERC_FAO ;File already open + +chkret: POP DI + RET +endif + + +locals ENDP + + +; Compiler Generated Library Calls + +entries PROC NEAR + + +;** $FL0 and $FIL - FILES statement + +;** $FL0 +; +; ENTRY NONE +; EXIT NONE + +$FL0: CALL $SAVREG + MOV BX,OFFSET DC:$FILNAM + MOV BYTE PTR [BX],0 ;Select default drive + INC BX + MOV CL,11 + CALL FILQST ;Fill name with ? + JMP SHORT fil01 ;Go to common code + + +;** $FIL +; +; ENTRY (BX) = filename sdesc +; USES NONE + +$FIL: CALL $SAVREG + CALL NAMFIL ;Scan file name +fil01: + MOV BYTE PTR [$FILNAM+12],0 ;Clear extent byte + MOV BX,OFFSET DC:$FILNAM+1 ;Point to filename + MOV CL,8 + CALL FILQS + MOV BX,OFFSET DC:$FILNAM+9 ;Point to extension + MOV CL,3 + CALL FILQS +if _MSDOS_ + MOV DX,OFFSET DC:$FILNM2 ;For MSDOS +;else +; MOV DX,OFFSET DC:$DIRTMP ;For CPM +endif + CALLOS C_BUFF ;Set buffer address + MOV DX,OFFSET DC:$FILNAM + CALLOS C_SEAR ;Search for filename + CMP AL,255 ;Test for 1st occurence of file + JZ ercfnf ; Not found + +filnxt: MOV SI,OFFSET DC:$FILNM2+1 ;Point to file name + MOV CX,11 ;Characters in name + +mornam: LODSB ;Get character + CALL $$WCHT ;Output it + CMP CX,4 + JNE notext ;Not an extension break + + MOV AL,[SI] ;Get 1st char of extension + CMP AL,' ' + JE prispa ;Blank extension - print space + + MOV AL,'.' ;Print . + +prispa: CALL $$WCHT ;Print blank or dot + +notext: LOOP mornam ;Loop until 11 characters + + CALL $TTY_GPOS ;Get TTY position + XCHG AL,AH + ADD AL,14-_IBM_ ;Position after next file name + CALL $TTY_GWID ;Get TTY width + CMP AL,AH + JAE nwfiln ;Force CR/LF + + MOV AL,' ' +ife _IBM_ + CALL $$WCHT +endif + CALL $$WCHT + JMP SHORT nextfl + +nwfiln: CALL $$TCR ;Type CR/LF + +nextfl: MOV DX,OFFSET DC:$FILNAM + CALLOS C_SEAR+1 + CMP AL,255 + JNE filnxt ;Still more + +nwfil2: RET + + + +;** $DKK - KILL filename +; +; ENTRY (BX) = filename sdesc +; USES NONE + +$DKK: CALL $SAVREG + CALL NAMFIL ;Scan file name +;if _CPM_ +; MOV DX,OFFSET DC:$DIRTMP ;Temporary buffer +; CALLOS C_BUFF ;Set buffer address +;endif + MOV DX,OFFSET DC:$FILNAM + CALLOS C_OPEN ;Open file + INC AL + JZ ercfnf ;File not found + CALLOS C_CLOS ;Close file +if _MSDOS_ + MOV SI,OFFSET DC:$FILNAM-1 ;Pretend we are FDB + CALL CHKFOP ;Check for conflict with open files +endif + CALLOS C_DELE ;Delete file + RET + +ercfnf: JMP $ERC_FNF ;File not found + + + +;** $DKR - NAME statement +; +; ENTRY (BX) = source name +; (DX) = dest name +; EXIT NONE + +$DKR: CALL $SAVREG + PUSH DX ;Save dest name + CALL NAMFIL ;Scan old file name + MOV DX,OFFSET DC:$FILNAM + CALLOS C_OPEN + INC AL + JZ ercfnf ;File not found + MOV SI,DX + MOV DI,OFFSET DC:$FILNM2 + MOV CX,FILNAM_LENGTH+1 ;+1 for drive + REP MOVSB ;Move name + POP BX ;Pop dest name + CALL NAMFIL ;Scan new filename + CALLOS C_OPEN + INC AL + JNZ ercfae ;File already exists + +;if _CPM_ +; MOV AL,[$FILNAM] ;Test to see if drives match +; CMP [$FILNM2],AL +; JE drvsok +; JMP $ERC_FC ;Illegal function call +;drvsok: +;endif + +if _MSDOS_ + MOV SI,DX + INC SI ;(SI) = $FILNAM+1 + MOV DI,OFFSET DC:$FILNM2+17 ;(DI) = dest for new file name + MOV CX,FILNAM_LENGTH ;No drive code + REP MOVSB ;Move name +endif + + MOV DX,OFFSET DC:$FILNM2 ;Point to 2nd FCB + CALLOS C_RENA ;Rename file + RET + +ercfae: JMP $ERC_FAE ;File already exists + + + +;** $RS2 - RESET statement; +; +; ENTRY NONE +; EXIT NONE + +$ZZ1: +$RS2: CALL $SAVREG + CALL $CLOSF ;Close all files + CALLOS C_GDRV ;Get drive number + PUSH AX + CALLOS C_REST ;Restore + POP AX + MOV DL,AL + CALLOS C_SDRV ;Set drive number + RET + + +entries ENDP + +filprc PROC NEAR + +filqs: CMP BYTE PTR [BX],'*' ;Test for * + JNE filret + +filqst: MOV BYTE PTR [BX],'?' ;Fill with ? + INC BX + DEC CL + JNZ filqst ;Keep looping + +filret: RET + +filprc ENDP + +CODE ENDS + + END From 31569d95a78559ad6816d14290e8edbedef5d14f Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 14 Jul 2026 18:06:14 -0700 Subject: [PATCH 34/53] Corrected data entry error in IODISK.ASM --- 2_printed_files/bundle_09/IODISK.ASM | 14 ++++++------ 3_source_code/BASLIB-86/IODISK.ASM | 34 ++++++++++++++-------------- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/2_printed_files/bundle_09/IODISK.ASM b/2_printed_files/bundle_09/IODISK.ASM index 765d3ea..7c74424 100644 --- a/2_printed_files/bundle_09/IODISK.ASM +++ b/2_printed_files/bundle_09/IODISK.ASM @@ -1732,19 +1732,19 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 1198 04D7 FE C0 INC AL 1199 04D9 75 13 JNZ ercfae ;File already exists 1200 -1201 ;if _CPM_ -1202 ; MOV AL,[$FILNAM] ;Test to see if drives match -1203 ; CMP [$FILNM2],AL -1204 ; JE drvsok +1201 if _CPM_ +1202 MOV AL,[$FILNAM] ;Test to see if drives match +1203 CMP [$FILNM2],AL +1204 JE drvsok IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-4 -1205 ; JMP $ERC_FC ;Illegal function call -1206 ;drvsok: -1207 ;endif +1205 JMP $ERC_FC ;Illegal function call +1206 drvsok: +1207 endif 1208 1209 if _MSDOS_ 1210 04DB 8B F2 MOV SI,DX diff --git a/3_source_code/BASLIB-86/IODISK.ASM b/3_source_code/BASLIB-86/IODISK.ASM index eb9fd25..2ab3ad4 100644 --- a/3_source_code/BASLIB-86/IODISK.ASM +++ b/3_source_code/BASLIB-86/IODISK.ASM @@ -67,10 +67,10 @@ endif ; Public Data Variables -;if _CPM_ -; PUBLIC $DIRTMP -;$DIRTMP DB REC_LENGTH DUP (?) ;Temporary buffer -;endif +if _CPM_ + PUBLIC $DIRTMP +$DIRTMP DB REC_LENGTH DUP (?) ;Temporary buffer +endif ; Local Data Variables @@ -858,8 +858,8 @@ fil01: CALL FILQS if _MSDOS_ MOV DX,OFFSET DC:$FILNM2 ;For MSDOS -;else -; MOV DX,OFFSET DC:$DIRTMP ;For CPM +else + MOV DX,OFFSET DC:$DIRTMP ;For CPM endif CALLOS C_BUFF ;Set buffer address MOV DX,OFFSET DC:$FILNAM @@ -917,10 +917,10 @@ nwfil2: RET $DKK: CALL $SAVREG CALL NAMFIL ;Scan file name -;if _CPM_ -; MOV DX,OFFSET DC:$DIRTMP ;Temporary buffer -; CALLOS C_BUFF ;Set buffer address -;endif +if _CPM_ + MOV DX,OFFSET DC:$DIRTMP ;Temporary buffer + CALLOS C_BUFF ;Set buffer address +endif MOV DX,OFFSET DC:$FILNAM CALLOS C_OPEN ;Open file INC AL @@ -960,13 +960,13 @@ $DKR: CALL $SAVREG INC AL JNZ ercfae ;File already exists -;if _CPM_ -; MOV AL,[$FILNAM] ;Test to see if drives match -; CMP [$FILNM2],AL -; JE drvsok -; JMP $ERC_FC ;Illegal function call -;drvsok: -;endif +if _CPM_ + MOV AL,[$FILNAM] ;Test to see if drives match + CMP [$FILNM2],AL + JE drvsok + JMP $ERC_FC ;Illegal function call +drvsok: +endif if _MSDOS_ MOV SI,DX From f359871a50649b1eeb05875f8aad2ed1ef14f903 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 15 Jul 2026 18:27:28 -0700 Subject: [PATCH 35/53] Corrected number alignment error in IODISK.ASM --- 2_printed_files/bundle_09/IODISK.ASM | 2536 +++++++++++++------------- 1 file changed, 1268 insertions(+), 1268 deletions(-) diff --git a/2_printed_files/bundle_09/IODISK.ASM b/2_printed_files/bundle_09/IODISK.ASM index 7c74424..0dbabbe 100644 --- a/2_printed_files/bundle_09/IODISK.ASM +++ b/2_printed_files/bundle_09/IODISK.ASM @@ -2,40 +2,40 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -1 TITLE IODISK - Disk I/O Drivers for BASCOM-86 -2 -3 ; This module contains the disk operating system interface -4 ; for the device I/O independent package. It also includes -5 ; other operating system features of BASIC. -6 -7 C INCLUDE TABMAC.INC -8 C ; Special Table Generation Macros -9 C -10 C ENTORG MACRO First_entry -11 C .XCREF -12 C ___ZZZ= First_entry -13 C .CREF -14 C ENDM -15 C -16 C -17 C ENT MACRO Lab,Incr -18 C Lab= ___ZZZ -19 C .XCREF -20 C ___ZZZ= ___ZZZ+Incr -21 C .CREF -22 C ENDM -23 C -24 C -25 C ENTI MACRO Incr -26 C .XCREF -27 C ___ZZZ= ___ZZZ+Incr -28 C .CREF -29 C ENDM -30 C -31 -32 0000 DATA SEGMENT WORD PUBLIC 'DATA' -33 -34 C INCLUDE DEVDEF.INC + 1 TITLE IODISK - Disk I/O Drivers for BASCOM-86 + 2 + 3 ; This module contains the disk operating system interface + 4 ; for the device I/O independent package. It also includes + 5 ; other operating system features of BASIC. + 6 + 7 C INCLUDE TABMAC.INC + 8 C ; Special Table Generation Macros + 9 C + 10 C ENTORG MACRO First_entry + 11 C .XCREF + 12 C ___ZZZ= First_entry + 13 C .CREF + 14 C ENDM + 15 C + 16 C + 17 C ENT MACRO Lab,Incr + 18 C Lab= ___ZZZ + 19 C .XCREF + 20 C ___ZZZ= ___ZZZ+Incr + 21 C .CREF + 22 C ENDM + 23 C + 24 C + 25 C ENTI MACRO Incr + 26 C .XCREF + 27 C ___ZZZ= ___ZZZ+Incr + 28 C .CREF + 29 C ENDM + 30 C + 31 + 32 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 33 + 34 C INCLUDE DEVDEF.INC @@ -62,40 +62,40 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -35 C PAGE -36 C -37 C ; DEVDEF.INC - Device Independent I/O Definitions -38 C -39 C INCLUDE SYSTEM.INC -40 C ; Operating System Selection -41 C -42 = 0000 C _IBM_= 0 -43 C -44 = 0001 C _MSDOS_= 1 -45 = 0000 C _CPM_= 0 -46 C -47 C ; Overrides -48 C -49 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ -50 C -51 C if1 -52 C if _CPM_ -53 C %OUT ! CP/M-86 Version -54 C endif -55 C if _MSDOS_ -56 C %OUT ! MSDOS Version -57 C endif -58 C if _IBM_ -59 C %OUT ! IBM Personal Computer -60 C endif -61 C -62 C if _MSDOS_+_CPM_ ne 1 -63 C %OUT ##################### Error - Bad Operating System Selection -64 C -65 C error -66 C endif -67 C endif -68 C + 35 C PAGE + 36 C + 37 C ; DEVDEF.INC - Device Independent I/O Definitions + 38 C + 39 C INCLUDE SYSTEM.INC + 40 C ; Operating System Selection + 41 C + 42 = 0000 C _IBM_= 0 + 43 C + 44 = 0001 C _MSDOS_= 1 + 45 = 0000 C _CPM_= 0 + 46 C + 47 C ; Overrides + 48 C + 49 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ + 50 C + 51 C if1 + 52 C if _CPM_ + 53 C %OUT ! CP/M-86 Version + 54 C endif + 55 C if _MSDOS_ + 56 C %OUT ! MSDOS Version + 57 C endif + 58 C if _IBM_ + 59 C %OUT ! IBM Personal Computer + 60 C endif + 61 C + 62 C if _MSDOS_+_CPM_ ne 1 + 63 C %OUT ##################### Error - Bad Operating System Selection + 64 C + 65 C error + 66 C endif + 67 C endif + 68 C @@ -122,35 +122,35 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -69 C PAGE -70 C -71 C DEVNAM MACRO -72 C DEVMAC KYBD -73 C DEVMAC SCRN -74 C if _IBM_ -75 C DEVMAC CAS1 -76 C DEVMAC COM1 -77 C DEVMAC COM2 -78 C endif -79 C DEVMAC LPT1 -80 C if _IBM_ -81 C DEVMAC LPT2 -82 C DEVMAC LPT3 -83 C endif -84 C ENDM -85 C -86 = FFFF C ___DEV= -1 -87 C -88 C DEVMAC MACRO ARG -89 C DN_&ARG= ___DEV -90 C .xcref -91 C ___DEV= ___DEV-1 -92 C .cref -93 C ENDM -94 C -95 C DEVNAM -96 C -97 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + 69 C PAGE + 70 C + 71 C DEVNAM MACRO + 72 C DEVMAC KYBD + 73 C DEVMAC SCRN + 74 C if _IBM_ + 75 C DEVMAC CAS1 + 76 C DEVMAC COM1 + 77 C DEVMAC COM2 + 78 C endif + 79 C DEVMAC LPT1 + 80 C if _IBM_ + 81 C DEVMAC LPT2 + 82 C DEVMAC LPT3 + 83 C endif + 84 C ENDM + 85 C + 86 = FFFF C ___DEV= -1 + 87 C + 88 C DEVMAC MACRO ARG + 89 C DN_&ARG= ___DEV + 90 C .xcref + 91 C ___DEV= ___DEV-1 + 92 C .cref + 93 C ENDM + 94 C + 95 C DEVNAM + 96 C + 97 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets @@ -182,37 +182,37 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -98 C PAGE -99 C -100 C DSPNAM MACRO -101 C DSPMAC EOF ;EOF function -102 C DSPMAC LOC ;LOC function -103 C DSPMAC LOF ;LOF function -104 C ; DSPMAC POS ;POS function -105 C DSPMAC CLOSE ;CLOSE statement -106 C DSPMAC WIDTH ;WIDTH statement -107 C DSPMAC RANDIO ;GET/PUT statements -108 C DSPMAC OPEN ;OPEN statement -109 C DSPMAC BAKC ;Backup character -110 C DSPMAC SINP ;Serial input -111 C DSPMAC SOUT ;Serial output -112 C DSPMAC GPOS ;Get current position -113 C DSPMAC GWID ;Get current width -114 C ENDM -115 C -116 C -117 C ; Device Function Dispatch Table Offsets -118 C -119 C -120 C DSPMAC MACRO func -121 C ENT DV_&func,2 -122 C ENDM -123 C -124 C -125 C ENTORG 0 -126 C DSPNAM -127 C ENT DV_TABLEN,0 -128 C + 98 C PAGE + 99 C + 100 C DSPNAM MACRO + 101 C DSPMAC EOF ;EOF function + 102 C DSPMAC LOC ;LOC function + 103 C DSPMAC LOF ;LOF function + 104 C ; DSPMAC POS ;POS function + 105 C DSPMAC CLOSE ;CLOSE statement + 106 C DSPMAC WIDTH ;WIDTH statement + 107 C DSPMAC RANDIO ;GET/PUT statements + 108 C DSPMAC OPEN ;OPEN statement + 109 C DSPMAC BAKC ;Backup character + 110 C DSPMAC SINP ;Serial input + 111 C DSPMAC SOUT ;Serial output + 112 C DSPMAC GPOS ;Get current position + 113 C DSPMAC GWID ;Get current width + 114 C ENDM + 115 C + 116 C + 117 C ; Device Function Dispatch Table Offsets + 118 C + 119 C + 120 C DSPMAC MACRO func + 121 C ENT DV_&func,2 + 122 C ENDM + 123 C + 124 C + 125 C ENTORG 0 + 126 C DSPNAM + 127 C ENT DV_TABLEN,0 + 128 C @@ -242,31 +242,31 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -129 C PAGE -130 C -131 C ; File Mode Definitions -132 C -133 = 0001 C MD_SQI EQU 1 -134 = 0002 C MD_SQO EQU 2 -135 = 0004 C MD_RND EQU 4 -136 = 0004 C MD_FIL EQU 4 -137 = 0008 C MD_APP EQU 8 -138 = 0010 C MD_KIL EQU 16 -139 = 0020 C MD_IBM EQU 32 -140 = 0040 C MD_USR EQU 64 -141 = 0080 C MD_BIN EQU 128 -142 C -143 C -144 C ; Operating System dependent field sizes -145 C -146 = 001A C EOFCHR= 'Z' and 1fh -147 C -148 = 0026 C FILNAML= 38 ;Length of $FILNAM -149 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) -150 C -151 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs -152 = 0080 C REC_LENGTH= 128 ;128 byte sectors -153 C + 129 C PAGE + 130 C + 131 C ; File Mode Definitions + 132 C + 133 = 0001 C MD_SQI EQU 1 + 134 = 0002 C MD_SQO EQU 2 + 135 = 0004 C MD_RND EQU 4 + 136 = 0004 C MD_FIL EQU 4 + 137 = 0008 C MD_APP EQU 8 + 138 = 0010 C MD_KIL EQU 16 + 139 = 0020 C MD_IBM EQU 32 + 140 = 0040 C MD_USR EQU 64 + 141 = 0080 C MD_BIN EQU 128 + 142 C + 143 C + 144 C ; Operating System dependent field sizes + 145 C + 146 = 001A C EOFCHR= 'Z' and 1fh + 147 C + 148 = 0026 C FILNAML= 38 ;Length of $FILNAM + 149 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) + 150 C + 151 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs + 152 = 0080 C REC_LENGTH= 128 ;128 byte sectors + 153 C @@ -302,112 +302,112 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -154 C PAGE -155 C -156 C ;----- Basic Interpreter style File Data Block ----- -157 C -158 C ; Link block offsets -159 C -160 = FFFA C BL_SIZE= -6 ;Link block size (2 bytes of misc) -161 = FFFB C FB_NUM= -5 ; File number -162 = FFFC C BL_LEN= -4 ;Block size -163 = FFFE C BL_LNK= -2 ;Block link -164 C -165 C ; File Data Block offsets -166 C -167 C FILE_DATA_BLOCK STRUC -168 C -169 0000 ?? C FD_MODE DB ? ;File mode of open -170 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area -171 ?? C -172 ] C -173 C -174 0027 ???? C FD_CURLOC DW ? ;Current record number -175 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector -176 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer -177 002B 03 [ C DB 3 DUP (?) ;Unused -178 ?? C -179 ] C -180 C -181 002E ?? C FD_DEVICE DB ? ;Device number -182 002F ?? C FD_WIDTH DB ? ;File width -183 0030 ?? C FD_POS DB ? ;Current file position -184 0031 ?? C FD_FLAGS DB ? ;Used for load and save -185 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion -186 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer -187 ?? C -188 ] C -189 C -190 C -191 C ; 5.0 Variable Record Information -192 C -193 00B3 ???? C FR_VRECL DW ? ;Variable record length -194 00B5 ???? C FR_PHYREC DW ? ;Current physical record number -195 00B7 ???? C FR_LOGREC DW ? ;Current logical record number -196 00B9 ?? C DB ? ;Future use -197 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O -198 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer -199 ?? C -200 ] C -201 C -202 C -203 00BD C FILE_DATA_BLOCK ENDS -204 C -205 C -206 C ; End of DEVDEF.INC -207 + 154 C PAGE + 155 C + 156 C ;----- Basic Interpreter style File Data Block ----- + 157 C + 158 C ; Link block offsets + 159 C + 160 = FFFA C BL_SIZE= -6 ;Link block size (2 bytes of misc) + 161 = FFFB C FB_NUM= -5 ; File number + 162 = FFFC C BL_LEN= -4 ;Block size + 163 = FFFE C BL_LNK= -2 ;Block link + 164 C + 165 C ; File Data Block offsets + 166 C + 167 C FILE_DATA_BLOCK STRUC + 168 C + 169 0000 ?? C FD_MODE DB ? ;File mode of open + 170 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area + 171 ?? C + 172 ] C + 173 C + 174 0027 ???? C FD_CURLOC DW ? ;Current record number + 175 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector + 176 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer + 177 002B 03 [ C DB 3 DUP (?) ;Unused + 178 ?? C + 179 ] C + 180 C + 181 002E ?? C FD_DEVICE DB ? ;Device number + 182 002F ?? C FD_WIDTH DB ? ;File width + 183 0030 ?? C FD_POS DB ? ;Current file position + 184 0031 ?? C FD_FLAGS DB ? ;Used for load and save + 185 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion + 186 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer + 187 ?? C + 188 ] C + 189 C + 190 C + 191 C ; 5.0 Variable Record Information + 192 C + 193 00B3 ???? C FR_VRECL DW ? ;Variable record length + 194 00B5 ???? C FR_PHYREC DW ? ;Current physical record number + 195 00B7 ???? C FR_LOGREC DW ? ;Current logical record number + 196 00B9 ?? C DB ? ;Future use + 197 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O + 198 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer + 199 ?? C + 200 ] C + 201 C + 202 C + 203 00BD C FILE_DATA_BLOCK ENDS + 204 C + 205 C + 206 C ; End of DEVDEF.INC + 207 IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 1-7 -208 PAGE -209 -210 ; Operating System Equates and Macros -211 -212 -213 ; MSDOS/CPM Operating System Function Codes -214 -215 = 000D C_REST= 13 -216 = 000E C_SDRV= 14 -217 = 000F C_OPEN= 15 -218 = 0010 C_CLOS= 16 -219 = 0011 C_SEAR= 17 -220 = 0013 C_DELE= 19 -221 = 0014 C_READ= 20 -222 = 0015 C_WRIT= 21 -223 = 0016 C_MAKE= 22 -224 = 0017 C_RENA= 23 -225 = 0019 C_GDRV= 25 -226 = 001A C_BUFF= 26 -227 = 0021 C_RNDR= 33 -228 = 0022 C_RNDW= 34 -229 -230 -231 ; MSDOS/CPM File Control Block Offsets -232 -233 = 0001 FCB_FN= 1 -234 = 0009 FCB_FT= 9 -235 = 000C FCB_EX= 12 -236 = 000E FCB_RSIZ= 14 ;MSDOS -237 = 000F FCB_RC= 15 ;MSDOS -238 = 0010 FCB_FSIZ= 16 ;MSDOS -239 = 0020 FCB_NR= 32 -240 = 0021 FCB_RN= 33 -241 -242 -243 ; MSDOS Call Macro -244 -245 if _MSDOS_ -246 CALLOS MACRO func -247 IFNB -248 MOV AH,func -249 ENDIF -250 INT 33 -251 ENDM -252 endif -253 + 208 PAGE + 209 + 210 ; Operating System Equates and Macros + 211 + 212 + 213 ; MSDOS/CPM Operating System Function Codes + 214 + 215 = 000D C_REST= 13 + 216 = 000E C_SDRV= 14 + 217 = 000F C_OPEN= 15 + 218 = 0010 C_CLOS= 16 + 219 = 0011 C_SEAR= 17 + 220 = 0013 C_DELE= 19 + 221 = 0014 C_READ= 20 + 222 = 0015 C_WRIT= 21 + 223 = 0016 C_MAKE= 22 + 224 = 0017 C_RENA= 23 + 225 = 0019 C_GDRV= 25 + 226 = 001A C_BUFF= 26 + 227 = 0021 C_RNDR= 33 + 228 = 0022 C_RNDW= 34 + 229 + 230 + 231 ; MSDOS/CPM File Control Block Offsets + 232 + 233 = 0001 FCB_FN= 1 + 234 = 0009 FCB_FT= 9 + 235 = 000C FCB_EX= 12 + 236 = 000E FCB_RSIZ= 14 ;MSDOS + 237 = 000F FCB_RC= 15 ;MSDOS + 238 = 0010 FCB_FSIZ= 16 ;MSDOS + 239 = 0020 FCB_NR= 32 + 240 = 0021 FCB_RN= 33 + 241 + 242 + 243 ; MSDOS Call Macro + 244 + 245 if _MSDOS_ + 246 CALLOS MACRO func + 247 IFNB + 248 MOV AH,func + 249 ENDIF + 250 INT 33 + 251 ENDM + 252 endif + 253 @@ -422,32 +422,32 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -254 PAGE -255 -256 ; External Data Variables -257 -258 EXTRN $FILNAM:BYTE, $FILNM2:BYTE, $FILMOD:BYTE -259 EXTRN $FILPT:WORD -260 EXTRN $$SPSV:WORD -261 -262 -263 ; Public Data Variables -264 -265 if _CPM_ -266 PUBLIC $DIRTMP -267 $DIRTMP DB REC_LENGTH DUP (?) ;Temporary buffer -268 endif -269 -270 -271 ; Local Data Variables -272 -273 0000 ???? RECORD DW ? ;Current record number -274 0002 ???? LBUFF DW ? ;Logical buffer address -275 0004 ???? PBUFF DW ? ;Physical buffer address -276 -277 0006 DATA ENDS -278 -279 DC GROUP DATA + 254 PAGE + 255 + 256 ; External Data Variables + 257 + 258 EXTRN $FILNAM:BYTE, $FILNM2:BYTE, $FILMOD:BYTE + 259 EXTRN $FILPT:WORD + 260 EXTRN $$SPSV:WORD + 261 + 262 + 263 ; Public Data Variables + 264 + 265 if _CPM_ + 266 PUBLIC $DIRTMP + 267 $DIRTMP DB REC_LENGTH DUP (?) ;Temporary buffer + 268 endif + 269 + 270 + 271 ; Local Data Variables + 272 + 273 0000 ???? RECORD DW ? ;Current record number + 274 0002 ???? LBUFF DW ? ;Logical buffer address + 275 0004 ???? PBUFF DW ? ;Physical buffer address + 276 + 277 0006 DATA ENDS + 278 + 279 DC GROUP DATA @@ -482,46 +482,46 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -280 -281 -282 0000 CODE SEGMENT BYTE PUBLIC 'CODE' -283 -284 ASSUME CS:CODE, DS:DC, ES:DC -285 -286 ; Compiler Generated Entries -287 -288 PUBLIC $DKK,$DKR,$FL0,$FIL,$RS2,$ZZ1 -289 -290 -291 ; Run-time entries -292 -293 PUBLIC $D_DISK -294 -295 -296 ; Run-time externals -297 -298 EXTRN $$DITS:NEAR, $SAVREG:NEAR -299 EXTRN $FBALC:NEAR, $FBDEA:NEAR -300 EXTRN $SCANF:NEAR, $CLOSF:NEAR, $DEVOPN:NEAR -301 EXTRN $$WCHT:NEAR, $$TCR:NEAR -302 EXTRN $TTY_GPOS:NEAR, $TTY_GWID:NEAR -303 -304 EXTRN $ERC_FC:NEAR -305 EXTRN $ERC_BFM:NEAR -306 EXTRN $ERC_BFN:NEAR -307 EXTRN $ERC_BRN:NEAR -308 EXTRN $ERC_DFL:NEAR -309 EXTRN $ERC_FAE:NEAR -310 EXTRN $ERC_FAO:NEAR -311 EXTRN $ERC_FNF:NEAR -312 EXTRN $ERC_FOV:NEAR -313 EXTRN $ERC_IOE:NEAR -314 EXTRN $ERC_TMF:NEAR -315 -316 if _MSDOS_ -317 EXTRN $DNORM:NEAR -318 endif -319 + 280 + 281 + 282 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 283 + 284 ASSUME CS:CODE, DS:DC, ES:DC + 285 + 286 ; Compiler Generated Entries + 287 + 288 PUBLIC $DKK,$DKR,$FL0,$FIL,$RS2,$ZZ1 + 289 + 290 + 291 ; Run-time entries + 292 + 293 PUBLIC $D_DISK + 294 + 295 + 296 ; Run-time externals + 297 + 298 EXTRN $$DITS:NEAR, $SAVREG:NEAR + 299 EXTRN $FBALC:NEAR, $FBDEA:NEAR + 300 EXTRN $SCANF:NEAR, $CLOSF:NEAR, $DEVOPN:NEAR + 301 EXTRN $$WCHT:NEAR, $$TCR:NEAR + 302 EXTRN $TTY_GPOS:NEAR, $TTY_GWID:NEAR + 303 + 304 EXTRN $ERC_FC:NEAR + 305 EXTRN $ERC_BFM:NEAR + 306 EXTRN $ERC_BFN:NEAR + 307 EXTRN $ERC_BRN:NEAR + 308 EXTRN $ERC_DFL:NEAR + 309 EXTRN $ERC_FAE:NEAR + 310 EXTRN $ERC_FAO:NEAR + 311 EXTRN $ERC_FNF:NEAR + 312 EXTRN $ERC_FOV:NEAR + 313 EXTRN $ERC_IOE:NEAR + 314 EXTRN $ERC_TMF:NEAR + 315 + 316 if _MSDOS_ + 317 EXTRN $DNORM:NEAR + 318 endif + 319 @@ -542,29 +542,29 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -320 PAGE -321 -322 ; Device Independent Disk Interface -323 -324 DSPMAC MACRO func -325 DW DISK_&func -326 ENDM -327 -328 0000 $D_DISK: -329 DSPNAM -330 0000 003D R + DW DISK_EOF -331 0002 006D R + DW DISK_LOC -332 0004 007A R + DW DISK_LOF -333 0006 0018 R + DW DISK_CLOSE -334 0008 0097 R + DW DISK_WIDTH -335 000A 0245 R + DW DISK_RANDIO -336 000C 0145 R + DW DISK_OPEN -337 000E 009B R + DW DISK_BAKC -338 0010 00D7 R + DW DISK_SINP -339 0012 0109 R + DW DISK_SOUT -340 0014 009F R + DW DISK_GPOS -341 0016 00A3 R + DW DISK_GWID -342 + 320 PAGE + 321 + 322 ; Device Independent Disk Interface + 323 + 324 DSPMAC MACRO func + 325 DW DISK_&func + 326 ENDM + 327 + 328 0000 $D_DISK: + 329 DSPNAM + 330 0000 003D R + DW DISK_EOF + 331 0002 006D R + DW DISK_LOC + 332 0004 007A R + DW DISK_LOF + 333 0006 0018 R + DW DISK_CLOSE + 334 0008 0097 R + DW DISK_WIDTH + 335 000A 0245 R + DW DISK_RANDIO + 336 000C 0145 R + DW DISK_OPEN + 337 000E 009B R + DW DISK_BAKC + 338 0010 00D7 R + DW DISK_SINP + 339 0012 0109 R + DW DISK_SOUT + 340 0014 009F R + DW DISK_GPOS + 341 0016 00A3 R + DW DISK_GWID + 342 @@ -602,107 +602,107 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -343 PAGE -344 -345 0018 devio_disk PROC NEAR -346 -347 -348 0018 DISK_CLOSE: -349 0018 80 3C 02 CMP [SI].FD_MODE,MD_SQO -350 001B 75 0E JNE noforc ;Don't dump buffer -351 -352 001D B0 1A MOV AL,EOFCHR -353 001F E8 0109 R CALL DISK_SOUT ;Write EOF character -354 0022 80 7C 29 00 CMP [SI].FD_ORNOFS,0 -355 0026 74 03 JE noforc ;Buffer already dumped -356 -357 0028 E8 035D R CALL WRITE_SECTOR ;Write sector -358 -359 002B 51 noforc: PUSH CX -360 002C 52 PUSH DX -361 002D 8D 54 01 LEA DX,[SI].FD_FCB -362 0030 E8 038B R CALL SETBUF ;Set buffer address -363 CALLOS C_CLOS ;Close file -364 0033 B4 10 + MOV AH,C_CLOS -365 0035 CD 21 + INT 33 -366 0037 E8 0000 E CALL $FBDEA ;Deallocate file buffer -367 003A 5A POP DX -368 003B 59 POP CX -369 003C C3 RET -370 -371 -372 -373 003D DISK_EOF: -374 003D 80 3C 02 CMP [SI].FD_MODE,MD_SQO -375 0040 74 28 JE ercbfm ;Not for output files -376 -377 0042 80 7C 29 00 ornchk: CMP [SI].FD_ORNOFS,0 -378 0046 74 1B JE waseof -379 -380 0048 33 DB XOR BX,BX -381 004A 80 3C 04 CMP [SI].FD_MODE,MD_RND -382 004D 74 1A JE eofret ;Not end of file -383 -384 004F 38 5C 2A CMP [SI].FD_NMLOFS,BL ;(BX) is 0 -385 0052 75 05 JNE chkctz ;Still characters in teh buffer -386 -387 0054 E8 0333 R CALL READ_SECTOR ;Read next sector -388 0057 EB E9 JMP ornchk -389 -390 0059 BB 0080 chkctz: MOV BX,REC_LENGTH -391 005C 2A 5C 2A SUB BL,[SI].FD_NMLOFS ;(BX) = character offset -392 005F 80 78 33 1A CMP [SI+BX].FD_BUFFER,EOFCHR -393 -394 0063 BB 0000 waseof: MOV BX,0 ;(BX) = not end of file -395 0066 75 01 JNE eofret -396 0068 4B DEC BX ;(BX) = -1 if end of file + 343 PAGE + 344 + 345 0018 devio_disk PROC NEAR + 346 + 347 + 348 0018 DISK_CLOSE: + 349 0018 80 3C 02 CMP [SI].FD_MODE,MD_SQO + 350 001B 75 0E JNE noforc ;Don't dump buffer + 351 + 352 001D B0 1A MOV AL,EOFCHR + 353 001F E8 0109 R CALL DISK_SOUT ;Write EOF character + 354 0022 80 7C 29 00 CMP [SI].FD_ORNOFS,0 + 355 0026 74 03 JE noforc ;Buffer already dumped + 356 + 357 0028 E8 035D R CALL WRITE_SECTOR ;Write sector + 358 + 359 002B 51 noforc: PUSH CX + 360 002C 52 PUSH DX + 361 002D 8D 54 01 LEA DX,[SI].FD_FCB + 362 0030 E8 038B R CALL SETBUF ;Set buffer address + 363 CALLOS C_CLOS ;Close file + 364 0033 B4 10 + MOV AH,C_CLOS + 365 0035 CD 21 + INT 33 + 366 0037 E8 0000 E CALL $FBDEA ;Deallocate file buffer + 367 003A 5A POP DX + 368 003B 59 POP CX + 369 003C C3 RET + 370 + 371 + 372 + 373 003D DISK_EOF: + 374 003D 80 3C 02 CMP [SI].FD_MODE,MD_SQO + 375 0040 74 28 JE ercbfm ;Not for output files + 376 + 377 0042 80 7C 29 00 ornchk: CMP [SI].FD_ORNOFS,0 + 378 0046 74 1B JE waseof + 379 + 380 0048 33 DB XOR BX,BX + 381 004A 80 3C 04 CMP [SI].FD_MODE,MD_RND + 382 004D 74 1A JE eofret ;Not end of file + 383 + 384 004F 38 5C 2A CMP [SI].FD_NMLOFS,BL ;(BX) is 0 + 385 0052 75 05 JNE chkctz ;Still characters in teh buffer + 386 + 387 0054 E8 0333 R CALL READ_SECTOR ;Read next sector + 388 0057 EB E9 JMP ornchk + 389 + 390 0059 BB 0080 chkctz: MOV BX,REC_LENGTH + 391 005C 2A 5C 2A SUB BL,[SI].FD_NMLOFS ;(BX) = character offset + 392 005F 80 78 33 1A CMP [SI+BX].FD_BUFFER,EOFCHR + 393 + 394 0063 BB 0000 waseof: MOV BX,0 ;(BX) = not end of file + 395 0066 75 01 JNE eofret + 396 0068 4B DEC BX ;(BX) = -1 if end of file IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-4 -397 0069 C3 eofret: RET -398 -399 006A E9 0000 E ercbfm: JMP $ERC_BFM -400 -401 006D DISK_LOC: -402 006D 80 3C 04 CMP [SI].FD_MODE,MD_RND -403 0070 8B 5C 27 MOV BX,[SI].FD_CURLOC ;Use CURLOC for sequential -404 0073 75 04 JNE loc1 -405 0075 8B 9C 00B7 MOV BX,[SI].FR_LOGREC ;Use LOGREC for random -406 0079 C3 loc1: RET -407 -408 -409 -410 007A DISK_LOF: -411 007A 51 PUSH CX -412 007B 52 PUSH DX -413 007C 53 PUSH BX -414 007D 8B 54 11 MOV DX,WORD PTR [SI].FD_FCB+FCB_FSIZ ;Get length of file -415 0080 8B 4C 13 MOV CX,WORD PTR [SI].FD_FCB+FCB_FSIZ+2 -416 0083 33 DB XOR BX,BX -417 0085 33 FF XOR DI,DI -418 0087 B8 C000 MOV AX,(64+80h)*100h ;(AX) = (exp+128,sign) -419 008A E8 0000 E CALL $DNORM ;Normalize as double -420 008D 5B POP BX -421 008E 5A POP DX -422 008F 59 POP CX -423 0090 C3 RET -424 -425 -426 -427 0091 DISK_POS: -428 0091 33 DB XOR BX,BX -429 0093 8A 5C 32 MOV BL,[SI].FD_OUTPOS ;(BX) = current file position -430 0096 C3 RET -431 -432 -433 -434 0097 DISK_WIDTH: -435 0097 88 54 2F MOV [SI].FD_WIDTH,DL ;Set file width -436 009A C3 RET -437 + 397 0069 C3 eofret: RET + 398 + 399 006A E9 0000 E ercbfm: JMP $ERC_BFM + 400 + 401 006D DISK_LOC: + 402 006D 80 3C 04 CMP [SI].FD_MODE,MD_RND + 403 0070 8B 5C 27 MOV BX,[SI].FD_CURLOC ;Use CURLOC for sequential + 404 0073 75 04 JNE loc1 + 405 0075 8B 9C 00B7 MOV BX,[SI].FR_LOGREC ;Use LOGREC for random + 406 0079 C3 loc1: RET + 407 + 408 + 409 + 410 007A DISK_LOF: + 411 007A 51 PUSH CX + 412 007B 52 PUSH DX + 413 007C 53 PUSH BX + 414 007D 8B 54 11 MOV DX,WORD PTR [SI].FD_FCB+FCB_FSIZ ;Get length of file + 415 0080 8B 4C 13 MOV CX,WORD PTR [SI].FD_FCB+FCB_FSIZ+2 + 416 0083 33 DB XOR BX,BX + 417 0085 33 FF XOR DI,DI + 418 0087 B8 C000 MOV AX,(64+80h)*100h ;(AX) = (exp+128,sign) + 419 008A E8 0000 E CALL $DNORM ;Normalize as double + 420 008D 5B POP BX + 421 008E 5A POP DX + 422 008F 59 POP CX + 423 0090 C3 RET + 424 + 425 + 426 + 427 0091 DISK_POS: + 428 0091 33 DB XOR BX,BX + 429 0093 8A 5C 32 MOV BL,[SI].FD_OUTPOS ;(BX) = current file position + 430 0096 C3 RET + 431 + 432 + 433 + 434 0097 DISK_WIDTH: + 435 0097 88 54 2F MOV [SI].FD_WIDTH,DL ;Set file width + 436 009A C3 RET + 437 @@ -722,24 +722,24 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -438 PAGE -439 -440 009B DISK_BAKC: -441 009B FE 44 2A INC [SI].FD_NMLOFS ;Backup 1 character -442 009E C3 RET -443 -444 -445 -446 009F DISK_GPOS: -447 009F 8A 64 32 MOV AH,[SI].FD_OUTPOS ;Get file output position -448 00A2 C3 RET -449 -450 -451 -452 00A3 DISK_GWID: -453 00A3 8A 64 2F MOV AH,[SI].FD_WIDTH ;Get file width -454 00A6 C3 RET -455 + 438 PAGE + 439 + 440 009B DISK_BAKC: + 441 009B FE 44 2A INC [SI].FD_NMLOFS ;Backup 1 character + 442 009E C3 RET + 443 + 444 + 445 + 446 009F DISK_GPOS: + 447 009F 8A 64 32 MOV AH,[SI].FD_OUTPOS ;Get file output position + 448 00A2 C3 RET + 449 + 450 + 451 + 452 00A3 DISK_GWID: + 453 00A3 8A 64 2F MOV AH,[SI].FD_WIDTH ;Get file width + 454 00A6 C3 RET + 455 @@ -782,75 +782,75 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -456 PAGE -457 -458 00A7 DISK_SINPB: -459 00A7 80 3C 04 CMP [SI].FD_MODE,MD_RND -460 00AA 75 03 JNE sinp1 -461 -462 00AC EB 3D 90 JMP SINP_50 ;Serial input from random -463 -464 00AF 80 7C 2A 00 sinp1: CMP [SI].FD_NMLOFS,0 -465 00B3 74 13 JE fillsq ;Sector is empty - get another -466 -467 00B5 53 PUSH BX -468 00B6 33 DB XOR BX,BX -469 00B8 8A 5C 29 MOV BL,[SI].FD_ORNOFS -470 00BB 2A 5C 2A SUB BL,[SI].FD_NMLOFS -471 00BE FE 4C 2A DEC [SI].FD_NMLOFS -472 00C1 8A 40 33 MOV AL,[SI+BX].FD_BUFFER ;(AL) = character -473 00C4 5B POP BX -474 00C5 0A C0 OR AL,AL ;Clear carry -475 00C7 C3 RET -476 -477 00C8 80 7C 29 00 fillsq: CMP [SI].FD_ORNOFS,0 -478 00CC 74 05 JE fills1 ;At end of file -479 -480 00CE E8 0333 R CALL READ_SECTOR ;Read next sector -481 00D1 75 04 JNE DISK_SINP ; Not at eof - try with new buffer -482 -483 00D3 F9 fills1: STC ;Set carry -484 00D4 B0 1A MOV AL,EOFCHR ;Return EOF character -485 -486 00D6 C3 sinret: RET -487 -488 00D7 DISK_SINP: -489 00D7 E8 00A7 R CALL DISK_SINPB ;Read binary character -490 00DA 72 FA JC sinret ; End of file -491 -492 00DC 3C 1A CMP AL,EOFCHR ;End of file character? -493 00DE F8 CLC ;Assume not -494 00DF 75 F5 JNE sinret ; Return -495 -496 00E1 C6 44 29 00 MOV [SI].FD_ORNOFS,0 ;Clear these offsets -497 00E5 C6 44 2A 00 MOV [SI].FD_NMLOFS,0 -498 00E9 F9 STC -499 00EA C3 RET -500 -501 00EB SINP_50: ;Serial input from random file -502 00EB 53 PUSH BX -503 00EC E8 00F6 R CALL FOVCHK ;Field overflow check -504 00EF 8A 80 00BB MOV AL,[SI+BX-1].FR_FIELD ;Get character -505 00F3 F8 CLC ;Clear carry -506 00F4 5B POP BX -507 00F5 C3 RET -508 -509 + 456 PAGE + 457 + 458 00A7 DISK_SINPB: + 459 00A7 80 3C 04 CMP [SI].FD_MODE,MD_RND + 460 00AA 75 03 JNE sinp1 + 461 + 462 00AC EB 3D 90 JMP SINP_50 ;Serial input from random + 463 + 464 00AF 80 7C 2A 00 sinp1: CMP [SI].FD_NMLOFS,0 + 465 00B3 74 13 JE fillsq ;Sector is empty - get another + 466 + 467 00B5 53 PUSH BX + 468 00B6 33 DB XOR BX,BX + 469 00B8 8A 5C 29 MOV BL,[SI].FD_ORNOFS + 470 00BB 2A 5C 2A SUB BL,[SI].FD_NMLOFS + 471 00BE FE 4C 2A DEC [SI].FD_NMLOFS + 472 00C1 8A 40 33 MOV AL,[SI+BX].FD_BUFFER ;(AL) = character + 473 00C4 5B POP BX + 474 00C5 0A C0 OR AL,AL ;Clear carry + 475 00C7 C3 RET + 476 + 477 00C8 80 7C 29 00 fillsq: CMP [SI].FD_ORNOFS,0 + 478 00CC 74 05 JE fills1 ;At end of file + 479 + 480 00CE E8 0333 R CALL READ_SECTOR ;Read next sector + 481 00D1 75 04 JNE DISK_SINP ; Not at eof - try with new buffer + 482 + 483 00D3 F9 fills1: STC ;Set carry + 484 00D4 B0 1A MOV AL,EOFCHR ;Return EOF character + 485 + 486 00D6 C3 sinret: RET + 487 + 488 00D7 DISK_SINP: + 489 00D7 E8 00A7 R CALL DISK_SINPB ;Read binary character + 490 00DA 72 FA JC sinret ; End of file + 491 + 492 00DC 3C 1A CMP AL,EOFCHR ;End of file character? + 493 00DE F8 CLC ;Assume not + 494 00DF 75 F5 JNE sinret ; Return + 495 + 496 00E1 C6 44 29 00 MOV [SI].FD_ORNOFS,0 ;Clear these offsets + 497 00E5 C6 44 2A 00 MOV [SI].FD_NMLOFS,0 + 498 00E9 F9 STC + 499 00EA C3 RET + 500 + 501 00EB SINP_50: ;Serial input from random file + 502 00EB 53 PUSH BX + 503 00EC E8 00F6 R CALL FOVCHK ;Field overflow check + 504 00EF 8A 80 00BB MOV AL,[SI+BX-1].FR_FIELD ;Get character + 505 00F3 F8 CLC ;Clear carry + 506 00F4 5B POP BX + 507 00F5 C3 RET + 508 + 509 IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-7 -510 00F6 8B 9C 00BA FOVCHK: MOV BX,[SI].FR_OUTPOS ;Get current position -511 00FA 3B 9C 00B3 CMP BX,[SI].FR_VRECL ;Check for end of record -512 00FE 74 06 JE ercfov ; Yes - field overflow -513 0100 43 INC BX ;Bump pointer -514 0101 89 9C 00BA MOV [SI].FR_OUTPOS,BX ;Save new position -515 0105 C3 RET -516 -517 0106 E9 0000 E ercfov: JMP $ERC_FOV -518 + 510 00F6 8B 9C 00BA FOVCHK: MOV BX,[SI].FR_OUTPOS ;Get current position + 511 00FA 3B 9C 00B3 CMP BX,[SI].FR_VRECL ;Check for end of record + 512 00FE 74 06 JE ercfov ; Yes - field overflow + 513 0100 43 INC BX ;Bump pointer + 514 0101 89 9C 00BA MOV [SI].FR_OUTPOS,BX ;Save new position + 515 0105 C3 RET + 516 + 517 0106 E9 0000 E ercfov: JMP $ERC_FOV + 518 @@ -902,48 +902,48 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -519 PAGE -520 -521 = 000D CR= 13 -522 -523 0109 DISK_SOUT: -524 0109 80 3C 04 CMP [SI].FD_MODE,MD_RND -525 010C 75 03 JNE sout1 -526 -527 010E EB 2A 90 JMP SOUT_50 ;Serial output to random -528 -529 0111 80 7C 29 80 sout1: CMP [SI].FD_ORNOFS,REC_LENGTH -530 0115 75 05 JNE sout2 ;Not at end of sector -531 -532 0117 50 PUSH AX -533 0118 E8 035D R CALL WRITE_SECTOR ;Write previous sector -534 011B 58 POP AX -535 -536 011C 53 sout2: PUSH BX -537 011D 33 DB XOR BX,BX -538 011F 8A 5C 29 MOV BL,[SI].FD_ORNOFS ;(BX) = buffer offset -539 0122 88 40 33 MOV [SI+BX].FD_BUFFER,AL ;Stuff character -540 0125 5B POP BX -541 0126 FE 44 29 INC [SI].FD_ORNOFS -542 -543 0129 3C 0D soutps: CMP AL,CR -544 012B 75 05 JNE sout3 -545 -546 012D C6 44 32 00 MOV [SI].FD_OUTPOS,0 ;Zero position -547 0131 C3 RET -548 -549 0132 3C 20 sout3: CMP AL,' ' -550 0134 F5 CMC -551 0135 80 54 32 00 ADC [SI].FD_OUTPOS,0 ;Add 1 if printing character -552 0139 C3 RET -553 -554 013A SOUT_50: ;Serial output to random file -555 013A 53 PUSH BX -556 013B E8 00F6 R CALL FOVCHK ;Check for field overflow -557 013E 88 80 00BB MOV [SI+BX-1].FR_FIELD,AL ;Store character -558 0142 5B POP BX -559 0143 EB E4 JMP soutps ;Update position -560 + 519 PAGE + 520 + 521 = 000D CR= 13 + 522 + 523 0109 DISK_SOUT: + 524 0109 80 3C 04 CMP [SI].FD_MODE,MD_RND + 525 010C 75 03 JNE sout1 + 526 + 527 010E EB 2A 90 JMP SOUT_50 ;Serial output to random + 528 + 529 0111 80 7C 29 80 sout1: CMP [SI].FD_ORNOFS,REC_LENGTH + 530 0115 75 05 JNE sout2 ;Not at end of sector + 531 + 532 0117 50 PUSH AX + 533 0118 E8 035D R CALL WRITE_SECTOR ;Write previous sector + 534 011B 58 POP AX + 535 + 536 011C 53 sout2: PUSH BX + 537 011D 33 DB XOR BX,BX + 538 011F 8A 5C 29 MOV BL,[SI].FD_ORNOFS ;(BX) = buffer offset + 539 0122 88 40 33 MOV [SI+BX].FD_BUFFER,AL ;Stuff character + 540 0125 5B POP BX + 541 0126 FE 44 29 INC [SI].FD_ORNOFS + 542 + 543 0129 3C 0D soutps: CMP AL,CR + 544 012B 75 05 JNE sout3 + 545 + 546 012D C6 44 32 00 MOV [SI].FD_OUTPOS,0 ;Zero position + 547 0131 C3 RET + 548 + 549 0132 3C 20 sout3: CMP AL,' ' + 550 0134 F5 CMC + 551 0135 80 54 32 00 ADC [SI].FD_OUTPOS,0 ;Add 1 if printing character + 552 0139 C3 RET + 553 + 554 013A SOUT_50: ;Serial output to random file + 555 013A 53 PUSH BX + 556 013B E8 00F6 R CALL FOVCHK ;Check for field overflow + 557 013E 88 80 00BB MOV [SI+BX-1].FR_FIELD,AL ;Store character + 558 0142 5B POP BX + 559 0143 EB E4 JMP soutps ;Update position + 560 @@ -962,177 +962,177 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -561 PAGE -562 -563 0145 DISK_OPEN: -564 0145 52 PUSH DX -565 0146 51 PUSH CX -566 -567 0147 80 3E 0000 E 04 CMP [$FILMOD],MD_RND ;See if random -568 014C 75 07 JNE notrnd ; No -569 014E 0B C9 OR CX,CX ;See if default record size -570 0150 75 03 JNE notrnd ; No -571 0152 B9 0080 MOV CX,REC_LENGTH ;Use record length as default -572 0155 51 notrnd: PUSH CX ;Save it for now -573 = 0089 ___TMP= FR_FIELD-FD_BUFFER ;Size beyond basic FDB -574 0156 81 C1 0089 ADD CX,___TMP -575 015A BA 00FF MOV DX,255 ;(DH,DL) = position,width -576 015D B4 FF MOV AH,255 ;(AH) = all file modes legal -577 015F E8 0000 E CALL $DEVOPN ;Allocate file block, etc. -578 0162 59 POP CX ;Get it back -579 0163 89 8C 00B3 MOV [SI].FR_VRECL,CX ;Set random record length -580 0167 56 PUSH SI -581 0168 8D 7C 01 LEA DI,[SI].FD_FCB -582 016B BE 0000 E MOV SI,OFFSET DC:$FILNAM -583 016E B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive -584 0171 F3/ A4 REP MOVSB ;Move in name into file block -585 0173 5E POP SI -586 0174 E8 038B R CALL SETBUF ;Set buffer address -587 -588 if _MSDOS_ -589 0177 80 3E 0000 E 08 CMP [$FILMOD],MD_APP -590 017C 75 03 JNE nochk -591 017E E8 03DF R CALL CHKFOP ;See if open -592 0181 nochk: -593 endif -594 -595 0181 8D 54 01 LEA DX,[SI].FD_FCB ;(DX) = FCB address -596 0184 80 3E 0000 E 02 CMP [$FILMOD],MD_SQO -597 0189 75 12 JNE opnfil ;Not sequential output -598 -599 if _MSDOS_ -600 018B E8 03DF R CALL CHKFOP ;Check if already open -601 endif -602 -603 CALLOS C_DELE ;Delete existing file -604 018E B4 13 + MOV AH,C_DELE -605 0190 CD 21 + INT 33 -606 -607 0192 makfil: CALLOS C_MAKE ;Create new file -608 0192 B4 16 + MOV AH,C_MAKE -609 0194 CD 21 + INT 33 -610 0196 FE C0 INC AL -611 0198 75 23 JNZ opnset ;Continue with OPEN -612 019A E9 0385 R JMP erctmf ;Directory full -613 -614 019D opnfil: CALLOS C_OPEN ;Open existing file + 561 PAGE + 562 + 563 0145 DISK_OPEN: + 564 0145 52 PUSH DX + 565 0146 51 PUSH CX + 566 + 567 0147 80 3E 0000 E 04 CMP [$FILMOD],MD_RND ;See if random + 568 014C 75 07 JNE notrnd ; No + 569 014E 0B C9 OR CX,CX ;See if default record size + 570 0150 75 03 JNE notrnd ; No + 571 0152 B9 0080 MOV CX,REC_LENGTH ;Use record length as default + 572 0155 51 notrnd: PUSH CX ;Save it for now + 573 = 0089 ___TMP= FR_FIELD-FD_BUFFER ;Size beyond basic FDB + 574 0156 81 C1 0089 ADD CX,___TMP + 575 015A BA 00FF MOV DX,255 ;(DH,DL) = position,width + 576 015D B4 FF MOV AH,255 ;(AH) = all file modes legal + 577 015F E8 0000 E CALL $DEVOPN ;Allocate file block, etc. + 578 0162 59 POP CX ;Get it back + 579 0163 89 8C 00B3 MOV [SI].FR_VRECL,CX ;Set random record length + 580 0167 56 PUSH SI + 581 0168 8D 7C 01 LEA DI,[SI].FD_FCB + 582 016B BE 0000 E MOV SI,OFFSET DC:$FILNAM + 583 016E B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive + 584 0171 F3/ A4 REP MOVSB ;Move in name into file block + 585 0173 5E POP SI + 586 0174 E8 038B R CALL SETBUF ;Set buffer address + 587 + 588 if _MSDOS_ + 589 0177 80 3E 0000 E 08 CMP [$FILMOD],MD_APP + 590 017C 75 03 JNE nochk + 591 017E E8 03DF R CALL CHKFOP ;See if open + 592 0181 nochk: + 593 endif + 594 + 595 0181 8D 54 01 LEA DX,[SI].FD_FCB ;(DX) = FCB address + 596 0184 80 3E 0000 E 02 CMP [$FILMOD],MD_SQO + 597 0189 75 12 JNE opnfil ;Not sequential output + 598 + 599 if _MSDOS_ + 600 018B E8 03DF R CALL CHKFOP ;Check if already open + 601 endif + 602 + 603 CALLOS C_DELE ;Delete existing file + 604 018E B4 13 + MOV AH,C_DELE + 605 0190 CD 21 + INT 33 + 606 + 607 0192 makfil: CALLOS C_MAKE ;Create new file + 608 0192 B4 16 + MOV AH,C_MAKE + 609 0194 CD 21 + INT 33 + 610 0196 FE C0 INC AL + 611 0198 75 23 JNZ opnset ;Continue with OPEN + 612 019A E9 0385 R JMP erctmf ;Directory full + 613 + 614 019D opnfil: CALLOS C_OPEN ;Open existing file IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-10 -615 019D B4 0F + MOV AH,C_OPEN -616 019F CD 21 + INT 33 -617 01A1 FE C0 INC AL -618 01A3 75 18 JNE opnset ;Continue with OPEN -619 -620 if _MSDOS_ -621 01A5 80 3E 0000 E 08 CMP [$FILMOD],MD_APP -622 01AA 75 07 JNE ntapnf -623 -624 01AC C6 06 0000 E 02 MOV [$FILMOD],MD_SQO ;Default to sequential output -625 01B1 EB DF JMP makfil -626 01B3 ntapnf: -627 endif -628 -629 01B3 80 3E 0000 E 04 CMP [$FILMOD],MD_RND -630 01B8 74 D8 JE makfil ;Create file for random -631 01BA E9 04B0 R JMP ercfnf -632 -633 01BD A0 0000 E opnset: MOV AL,[$FILMOD] -634 01C0 88 04 MOV [SI].FD_MODE,AL ;Everything is OK - set file mode -635 -636 if _MSDOS_ -637 01C2 C7 44 0F 0080 MOV WORD PTR [SI].FD_FCB+FCB_RSIZ,REC_LENGTH -638 endif -639 -640 01C7 80 3C 04 CMP [SI].FD_MODE,MD_RND -641 01CA 74 0D JE opnret ;Done if random -642 -643 if _MSDOS_ -644 01CC 80 3C 08 CMP [SI].FD_MODE,MD_APP -645 01CF 74 0B JE appfin ;Special if append -646 endif -647 -648 01D1 80 3C 01 CMP [SI].FD_MODE,MD_SQI -649 01D4 75 03 JNE opnret ;Done if not input -650 -651 01D6 E8 0333 R CALL READ_SECTOR ;Read 1st sector -652 -653 01D9 59 opnret: POP CX -654 01DA 5A POP DX -655 01DB C3 RET -656 -657 if _MSDOS_ -658 -659 01DC appfin: ;Special code to find end of file -660 -661 01DC 83 7C 11 00 CMP WORD PTR [SI].FD_FCB+FCB_FSIZ,0 ;Test for empty file -662 01E0 75 0B JNE ntzrfl -663 01E2 83 7C 13 00 CMP WORD PTR [SI].FD_FCB+FCB_FSIZ+2,0 -664 01E6 75 05 JNE ntzrfl -665 -666 01E8 C6 04 02 MOV [SI].FD_MODE,MD_SQO ;Set mode to output -667 01EB EB EC JMP opnret ; and return -668 + 615 019D B4 0F + MOV AH,C_OPEN + 616 019F CD 21 + INT 33 + 617 01A1 FE C0 INC AL + 618 01A3 75 18 JNE opnset ;Continue with OPEN + 619 + 620 if _MSDOS_ + 621 01A5 80 3E 0000 E 08 CMP [$FILMOD],MD_APP + 622 01AA 75 07 JNE ntapnf + 623 + 624 01AC C6 06 0000 E 02 MOV [$FILMOD],MD_SQO ;Default to sequential output + 625 01B1 EB DF JMP makfil + 626 01B3 ntapnf: + 627 endif + 628 + 629 01B3 80 3E 0000 E 04 CMP [$FILMOD],MD_RND + 630 01B8 74 D8 JE makfil ;Create file for random + 631 01BA E9 04B0 R JMP ercfnf + 632 + 633 01BD A0 0000 E opnset: MOV AL,[$FILMOD] + 634 01C0 88 04 MOV [SI].FD_MODE,AL ;Everything is OK - set file mode + 635 + 636 if _MSDOS_ + 637 01C2 C7 44 0F 0080 MOV WORD PTR [SI].FD_FCB+FCB_RSIZ,REC_LENGTH + 638 endif + 639 + 640 01C7 80 3C 04 CMP [SI].FD_MODE,MD_RND + 641 01CA 74 0D JE opnret ;Done if random + 642 + 643 if _MSDOS_ + 644 01CC 80 3C 08 CMP [SI].FD_MODE,MD_APP + 645 01CF 74 0B JE appfin ;Special if append + 646 endif + 647 + 648 01D1 80 3C 01 CMP [SI].FD_MODE,MD_SQI + 649 01D4 75 03 JNE opnret ;Done if not input + 650 + 651 01D6 E8 0333 R CALL READ_SECTOR ;Read 1st sector + 652 + 653 01D9 59 opnret: POP CX + 654 01DA 5A POP DX + 655 01DB C3 RET + 656 + 657 if _MSDOS_ + 658 + 659 01DC appfin: ;Special code to find end of file + 660 + 661 01DC 83 7C 11 00 CMP WORD PTR [SI].FD_FCB+FCB_FSIZ,0 ;Test for empty file + 662 01E0 75 0B JNE ntzrfl + 663 01E2 83 7C 13 00 CMP WORD PTR [SI].FD_FCB+FCB_FSIZ+2,0 + 664 01E6 75 05 JNE ntzrfl + 665 + 666 01E8 C6 04 02 MOV [SI].FD_MODE,MD_SQO ;Set mode to output + 667 01EB EB EC JMP opnret ; and return + 668 IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-11 -669 01ED 8D 7C 22 ntzrfl: LEA DI,[SI].FD_FCB+FCB_RN ;Point to random record number -670 01F0 56 PUSH SI -671 01F1 83 C6 11 ADD SI,FD_FCB+FCB_FSIZ ;Point to file size -672 01F4 F6 04 7F TEST BYTE PTR [SI],127 ;See if multiple of 128 -673 01F7 9C PUSHF ; Save flags -674 01F8 AC LODSB ;Get low order byte of file size -675 01F9 D0 E0 SAL AL,1 ;Rotate high bit into carry -676 01FB AD LODSW ;Get middle word -677 01FC D1 E0 SAL AX,1 ;Rotate carry in and high bit out -678 01FE AB STOSW ;Save low word of file size -679 01FF AC LODSB ;Get high order byte -680 0200 B4 00 MOV AH,0 ;Clear high byte of record number -681 0202 D1 E0 SAL AX,1 ;Rotate carry in -682 0204 AB STOSW ;Save high word of record number -683 0205 9D POPF ;Restore flags -684 0206 5E POP SI ;Restore pointer to file data block -685 0207 75 03 JNZ nomtrc ;Record is not empty -686 -687 0209 E8 0235 R CALL BAKURN ;Backup record number -688 -689 020C E8 0333 R nomtrc: CALL READ_SECTOR ;Read record -690 020F E8 0235 R CALL BAKURN ;Backup record number -691 0212 33 D2 XOR DX,DX ;Number of characters in buffer -692 -693 0214 E8 00A7 R redoef: CALL DISK_SINPB ;Read binary character -694 0217 72 07 JC setsqm ; Hit physical EOF -695 -696 0219 3C 1A CMP AL,EOFCHR -697 021B 74 08 JE setsqo ;Found end of file -698 -699 021D 42 INC DX -700 021E EB F4 JMP redoef ;Keep looping -701 -702 0220 33 D2 setsqm: XOR DX,DX ;Start of record -703 0222 E8 0235 R CALL BAKURN ;Read 1 past -704 -705 0225 C6 04 02 setsqo: MOV [SI].FD_MODE,MD_SQO ;Ready for sequential output now -706 0228 8D 7C 27 LEA DI,[SI].FD_CURLOC ;Point to current location -707 022B 33 C0 XOR AX,AX -708 022D AB STOSW ;Clear current location -709 022E 88 15 MOV [DI],DL ;Set number of bytes in buffer -710 0230 88 44 32 MOV [SI].FD_OUTPOS,AL ;Clear print position -711 0233 EB A4 JMP opnret ;Done with append -712 -713 0235 83 6C 22 01 BAKURN: SUB WORD PTR [SI].FD_FCB+FCB_RN,1 ;Decrement random record number -714 0239 73 03 JAE bakret ;Done - no underflow -715 023B FF 4C 24 DEC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Decrement high word -716 023E C3 bakret: RET -717 -718 endif -719 + 669 01ED 8D 7C 22 ntzrfl: LEA DI,[SI].FD_FCB+FCB_RN ;Point to random record number + 670 01F0 56 PUSH SI + 671 01F1 83 C6 11 ADD SI,FD_FCB+FCB_FSIZ ;Point to file size + 672 01F4 F6 04 7F TEST BYTE PTR [SI],127 ;See if multiple of 128 + 673 01F7 9C PUSHF ; Save flags + 674 01F8 AC LODSB ;Get low order byte of file size + 675 01F9 D0 E0 SAL AL,1 ;Rotate high bit into carry + 676 01FB AD LODSW ;Get middle word + 677 01FC D1 E0 SAL AX,1 ;Rotate carry in and high bit out + 678 01FE AB STOSW ;Save low word of file size + 679 01FF AC LODSB ;Get high order byte + 680 0200 B4 00 MOV AH,0 ;Clear high byte of record number + 681 0202 D1 E0 SAL AX,1 ;Rotate carry in + 682 0204 AB STOSW ;Save high word of record number + 683 0205 9D POPF ;Restore flags + 684 0206 5E POP SI ;Restore pointer to file data block + 685 0207 75 03 JNZ nomtrc ;Record is not empty + 686 + 687 0209 E8 0235 R CALL BAKURN ;Backup record number + 688 + 689 020C E8 0333 R nomtrc: CALL READ_SECTOR ;Read record + 690 020F E8 0235 R CALL BAKURN ;Backup record number + 691 0212 33 D2 XOR DX,DX ;Number of characters in buffer + 692 + 693 0214 E8 00A7 R redoef: CALL DISK_SINPB ;Read binary character + 694 0217 72 07 JC setsqm ; Hit physical EOF + 695 + 696 0219 3C 1A CMP AL,EOFCHR + 697 021B 74 08 JE setsqo ;Found end of file + 698 + 699 021D 42 INC DX + 700 021E EB F4 JMP redoef ;Keep looping + 701 + 702 0220 33 D2 setsqm: XOR DX,DX ;Start of record + 703 0222 E8 0235 R CALL BAKURN ;Read 1 past + 704 + 705 0225 C6 04 02 setsqo: MOV [SI].FD_MODE,MD_SQO ;Ready for sequential output now + 706 0228 8D 7C 27 LEA DI,[SI].FD_CURLOC ;Point to current location + 707 022B 33 C0 XOR AX,AX + 708 022D AB STOSW ;Clear current location + 709 022E 88 15 MOV [DI],DL ;Set number of bytes in buffer + 710 0230 88 44 32 MOV [SI].FD_OUTPOS,AL ;Clear print position + 711 0233 EB A4 JMP opnret ;Done with append + 712 + 713 0235 83 6C 22 01 BAKURN: SUB WORD PTR [SI].FD_FCB+FCB_RN,1 ;Decrement random record number + 714 0239 73 03 JAE bakret ;Done - no underflow + 715 023B FF 4C 24 DEC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Decrement high word + 716 023E C3 bakret: RET + 717 + 718 endif + 719 @@ -1142,172 +1142,172 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -720 PAGE -721 -722 = 0001 PUTFLG= 1 ;on = PUT , off = GET -723 = 0002 RELFLG= 2 ;on = relative , off = sequential -724 = 0004 DIRFLG= 4 ;on = WRITE , off = READ -725 -726 023F E9 0000 E ercfc: JMP $ERC_FC -727 0242 E9 0000 E ercbrn: JMP $ERC_BRN -728 -729 0245 DISK_RANDIO: -730 0245 51 PUSH CX -731 0246 52 PUSH DX -732 0247 53 PUSH BX -733 0248 A8 02 TEST AL,RELFLG ;Check for relative record number -734 024A 75 07 JNZ rand1 -735 -736 024C 8B 94 00B7 MOV DX,[SI].FR_LOGREC ;(DX) = current logical record -737 0250 42 INC DX ;Bump by 1 -738 0251 EB 04 JMP SHORT rand2 -739 -740 0253 0B D2 rand1: OR DX,DX ;Check for bad record number -741 0255 7E EB JLE ercbrn ; Error - 0 or negative -742 -743 0257 89 94 00B7 rand2: MOV [SI].FR_LOGREC,DX ;Save next record number -744 025B 4A DEC DX ;(DX) = current logical record number -745 025C C7 84 00BA 0000 MOV [SI].FR_OUTPOS,0 ;Clear output position -746 0262 8B 9C 00B3 MOV BX,[SI].FR_VRECL ;(BX) = logical record length -747 0266 53 PUSH BX -748 0267 81 FB 0080 CMP BX,REC_LENGTH ;Check if logical size = physical -749 026B 74 16 JE rand3 -750 -751 026D 93 XCHG AX,BX ;Save (AL) for now -752 026E F7 E2 MUL DX ;(DX,AX) = record * size (byte offset) -753 0270 93 XCHG AX,BX ;(DX,BX) = result -754 0271 03 DB ADD BX,BX ;Offset * 2 (for /128) -755 0273 13 D2 ADC DX,DX -756 0275 0A F6 OR DH,DH ;Test for too big -757 0277 75 C6 JNZ ercfc ; Yes -758 0279 8A F2 MOV DH,DL -759 027B 8A D7 MOV DL,BH ;(DX) = physical record number -760 027D D0 EB SHR BL,1 -761 027F 32 FF XOR BH,BH ;(BX) = offset into physical record -762 0281 EB 02 JMP SHORT rand4 -763 -764 0283 33 DB rand3: XOR BX,BX ;(BX) = 0 (offset) -765 -766 ; (DX) = physical record number -767 ; (BX) = offset into physical record -768 -769 0285 89 16 0000 R rand4: MOV [RECORD],DX ;Save record number -770 0289 8D 8C 00BC LEA CX,[SI].FR_FIELD ;(CX) = logical buffer address -771 028D 89 0E 0002 R MOV [LBUFF],CX ;Save as LBUFF -772 0291 5A POP DX ;Get record length -773 + 720 PAGE + 721 + 722 = 0001 PUTFLG= 1 ;on = PUT , off = GET + 723 = 0002 RELFLG= 2 ;on = relative , off = sequential + 724 = 0004 DIRFLG= 4 ;on = WRITE , off = READ + 725 + 726 023F E9 0000 E ercfc: JMP $ERC_FC + 727 0242 E9 0000 E ercbrn: JMP $ERC_BRN + 728 + 729 0245 DISK_RANDIO: + 730 0245 51 PUSH CX + 731 0246 52 PUSH DX + 732 0247 53 PUSH BX + 733 0248 A8 02 TEST AL,RELFLG ;Check for relative record number + 734 024A 75 07 JNZ rand1 + 735 + 736 024C 8B 94 00B7 MOV DX,[SI].FR_LOGREC ;(DX) = current logical record + 737 0250 42 INC DX ;Bump by 1 + 738 0251 EB 04 JMP SHORT rand2 + 739 + 740 0253 0B D2 rand1: OR DX,DX ;Check for bad record number + 741 0255 7E EB JLE ercbrn ; Error - 0 or negative + 742 + 743 0257 89 94 00B7 rand2: MOV [SI].FR_LOGREC,DX ;Save next record number + 744 025B 4A DEC DX ;(DX) = current logical record number + 745 025C C7 84 00BA 0000 MOV [SI].FR_OUTPOS,0 ;Clear output position + 746 0262 8B 9C 00B3 MOV BX,[SI].FR_VRECL ;(BX) = logical record length + 747 0266 53 PUSH BX + 748 0267 81 FB 0080 CMP BX,REC_LENGTH ;Check if logical size = physical + 749 026B 74 16 JE rand3 + 750 + 751 026D 93 XCHG AX,BX ;Save (AL) for now + 752 026E F7 E2 MUL DX ;(DX,AX) = record * size (byte offset) + 753 0270 93 XCHG AX,BX ;(DX,BX) = result + 754 0271 03 DB ADD BX,BX ;Offset * 2 (for /128) + 755 0273 13 D2 ADC DX,DX + 756 0275 0A F6 OR DH,DH ;Test for too big + 757 0277 75 C6 JNZ ercfc ; Yes + 758 0279 8A F2 MOV DH,DL + 759 027B 8A D7 MOV DL,BH ;(DX) = physical record number + 760 027D D0 EB SHR BL,1 + 761 027F 32 FF XOR BH,BH ;(BX) = offset into physical record + 762 0281 EB 02 JMP SHORT rand4 + 763 + 764 0283 33 DB rand3: XOR BX,BX ;(BX) = 0 (offset) + 765 + 766 ; (DX) = physical record number + 767 ; (BX) = offset into physical record + 768 + 769 0285 89 16 0000 R rand4: MOV [RECORD],DX ;Save record number + 770 0289 8D 8C 00BC LEA CX,[SI].FR_FIELD ;(CX) = logical buffer address + 771 028D 89 0E 0002 R MOV [LBUFF],CX ;Save as LBUFF + 772 0291 5A POP DX ;Get record length + 773 IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-13 -774 ; (DX) = bytes left to transfer (initially record length) -775 ; (BX) = offset into current record -776 -777 0292 8D 4C 33 nxtopd: LEA CX,[SI].FD_BUFFER ;(CX) = physical buffer address -778 0295 03 CB ADD CX,BX ;Add in offset -779 0297 89 0E 0004 R MOV [PBUFF],CX ;Save in PBUFF -780 029B B9 0080 MOV CX,REC_LENGTH -781 029E 2B CB SUB CX,BX ;(CX) = bytes left in sector -782 02A0 3B CA CMP CX,DX ;find smaller left (buffer : record) -783 02A2 72 02 JB datmof ;(CX) = left in buffer -784 02A4 8B CA MOV CX,DX ;(CX) = left in record -785 02A6 A8 01 datmof: TEST AL,PUTFLG ;Check for read (GET) -786 02A8 74 33 JZ fivdrd ; Yes -787 -788 02AA 81 F9 0080 CMP CX,REC_LENGTH ;Writing entire sector? -789 02AE 73 03 JAE nofvrd ; Yes -790 -791 02B0 E8 02F9 R CALL GETSUB ;Read current sector -792 -793 02B3 56 nofvrd: PUSH SI ;Move logical to physical -794 02B4 51 PUSH CX -795 02B5 8B 36 0002 R MOV SI,[LBUFF] -796 02B9 8B 3E 0004 R MOV DI,[PBUFF] -797 02BD D1 E9 SHR CX,1 -798 02BF F3/ A5 REP MOVSW -799 02C1 73 01 JNC evenlp -800 02C3 A4 MOVSB -801 02C4 59 evenlp: POP CX -802 02C5 5E POP SI -803 -804 02C6 E8 02F5 R CALL PUTSUB ;Write through to current sector -805 -806 02C9 FF 06 0000 R nxfvbf: INC [RECORD] ;Bump current record number -807 02CD 01 0E 0002 R ADD [LBUFF],CX ;Bump logical buffer offset -808 02D1 2B D1 SUB DX,CX ;Subtract bytes transferred -809 02D3 33 DB XOR BX,BX ;Zero offset into buffer -810 02D5 0B D2 OR DX,DX ;Check for more to transfer -811 02D7 75 B9 JNZ nxtopd ; Yes - keep looping -812 -813 02D9 5B POP BX -814 02DA 5A POP DX -815 02DB 59 POP CX -816 02DC C3 RET -817 -818 02DD E8 02F9 R fivdrd: CALL GETSUB ;Read current record -819 -820 02E0 56 PUSH SI ;Transfer from physical to logical -821 02E1 51 PUSH CX -822 02E2 8B 36 0004 R MOV SI,[PBUFF] -823 02E6 8B 3E 0002 R MOV DI,[LBUFF] -824 02EA D1 E9 SHR CX,1 -825 02EC F3/ A5 REP MOVSW -826 02EE 73 01 JNC evenpl -827 02F0 A4 MOVSB + 774 ; (DX) = bytes left to transfer (initially record length) + 775 ; (BX) = offset into current record + 776 + 777 0292 8D 4C 33 nxtopd: LEA CX,[SI].FD_BUFFER ;(CX) = physical buffer address + 778 0295 03 CB ADD CX,BX ;Add in offset + 779 0297 89 0E 0004 R MOV [PBUFF],CX ;Save in PBUFF + 780 029B B9 0080 MOV CX,REC_LENGTH + 781 029E 2B CB SUB CX,BX ;(CX) = bytes left in sector + 782 02A0 3B CA CMP CX,DX ;find smaller left (buffer : record) + 783 02A2 72 02 JB datmof ;(CX) = left in buffer + 784 02A4 8B CA MOV CX,DX ;(CX) = left in record + 785 02A6 A8 01 datmof: TEST AL,PUTFLG ;Check for read (GET) + 786 02A8 74 33 JZ fivdrd ; Yes + 787 + 788 02AA 81 F9 0080 CMP CX,REC_LENGTH ;Writing entire sector? + 789 02AE 73 03 JAE nofvrd ; Yes + 790 + 791 02B0 E8 02F9 R CALL GETSUB ;Read current sector + 792 + 793 02B3 56 nofvrd: PUSH SI ;Move logical to physical + 794 02B4 51 PUSH CX + 795 02B5 8B 36 0002 R MOV SI,[LBUFF] + 796 02B9 8B 3E 0004 R MOV DI,[PBUFF] + 797 02BD D1 E9 SHR CX,1 + 798 02BF F3/ A5 REP MOVSW + 799 02C1 73 01 JNC evenlp + 800 02C3 A4 MOVSB + 801 02C4 59 evenlp: POP CX + 802 02C5 5E POP SI + 803 + 804 02C6 E8 02F5 R CALL PUTSUB ;Write through to current sector + 805 + 806 02C9 FF 06 0000 R nxfvbf: INC [RECORD] ;Bump current record number + 807 02CD 01 0E 0002 R ADD [LBUFF],CX ;Bump logical buffer offset + 808 02D1 2B D1 SUB DX,CX ;Subtract bytes transferred + 809 02D3 33 DB XOR BX,BX ;Zero offset into buffer + 810 02D5 0B D2 OR DX,DX ;Check for more to transfer + 811 02D7 75 B9 JNZ nxtopd ; Yes - keep looping + 812 + 813 02D9 5B POP BX + 814 02DA 5A POP DX + 815 02DB 59 POP CX + 816 02DC C3 RET + 817 + 818 02DD E8 02F9 R fivdrd: CALL GETSUB ;Read current record + 819 + 820 02E0 56 PUSH SI ;Transfer from physical to logical + 821 02E1 51 PUSH CX + 822 02E2 8B 36 0004 R MOV SI,[PBUFF] + 823 02E6 8B 3E 0002 R MOV DI,[LBUFF] + 824 02EA D1 E9 SHR CX,1 + 825 02EC F3/ A5 REP MOVSW + 826 02EE 73 01 JNC evenpl + 827 02F0 A4 MOVSB IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 2-14 -828 02F1 59 evenpl: POP CX -829 02F2 5E POP SI -830 02F3 EB D4 JMP nxfvbf ;Go to common code -831 -832 ; Sector I/O routines for random -833 -834 02F5 0C 04 PUTSUB: OR AL,DIRFLG ;Set write flag -835 02F7 EB 02 JMP SHORT pgsub1 -836 -837 02F9 24 FB GETSUB: AND AL,not DIRFLG ;Clear write flag (read) -838 -839 02FB 50 pgsub1: PUSH AX -840 02FC 51 PUSH CX -841 02FD 52 PUSH DX -842 02FE 53 PUSH BX -843 02FF 8B 1E 0000 R MOV BX,[RECORD] ;Get record number -844 0303 43 INC BX -845 0304 3B 9C 00B5 CMP BX,[SI].FR_PHYREC ;Check if current record in buffer -846 0308 75 04 JNE ntreds ; No -847 -848 030A A8 04 TEST AL,DIRFLG ;Check if read -849 030C 74 20 JZ pgret ; Yes - do not bother -850 -851 030E 4B ntreds: DEC BX -852 030F 89 5C 27 MOV [SI].FD_CURLOC,BX ;Set CURLOC to physical record -853 0312 C6 44 29 80 MOV [SI].FD_ORNOFS,REC_LENGTH -854 0316 C6 44 2A 80 MOV [SI].FD_NMLOFS,REC_LENGTH -855 031A 89 5C 22 MOV WORD PTR [SI].FD_FCB+FCB_RN,BX ;Set record number -856 031D C7 44 24 0000 MOV WORD PTR [SI].FD_FCB+FCB_RN+2,0 -857 -858 0322 A8 04 TEST AL,DIRFLG ;Check if read -859 0324 74 05 JZ get1 ; Yes - read -860 -861 0326 E8 035D R CALL WRITE_SECTOR ;Write it -862 0329 EB 03 JMP SHORT pgret ;Done -863 -864 032B E8 0333 R get1: CALL READ_SECTOR ;Read it -865 -866 032E 5B pgret: POP BX -867 032F 5A POP DX -868 0330 59 POP CX -869 0331 58 POP AX -870 0332 C3 RET -871 -872 -873 0333 devio_disk ENDP + 828 02F1 59 evenpl: POP CX + 829 02F2 5E POP SI + 830 02F3 EB D4 JMP nxfvbf ;Go to common code + 831 + 832 ; Sector I/O routines for random + 833 + 834 02F5 0C 04 PUTSUB: OR AL,DIRFLG ;Set write flag + 835 02F7 EB 02 JMP SHORT pgsub1 + 836 + 837 02F9 24 FB GETSUB: AND AL,not DIRFLG ;Clear write flag (read) + 838 + 839 02FB 50 pgsub1: PUSH AX + 840 02FC 51 PUSH CX + 841 02FD 52 PUSH DX + 842 02FE 53 PUSH BX + 843 02FF 8B 1E 0000 R MOV BX,[RECORD] ;Get record number + 844 0303 43 INC BX + 845 0304 3B 9C 00B5 CMP BX,[SI].FR_PHYREC ;Check if current record in buffer + 846 0308 75 04 JNE ntreds ; No + 847 + 848 030A A8 04 TEST AL,DIRFLG ;Check if read + 849 030C 74 20 JZ pgret ; Yes - do not bother + 850 + 851 030E 4B ntreds: DEC BX + 852 030F 89 5C 27 MOV [SI].FD_CURLOC,BX ;Set CURLOC to physical record + 853 0312 C6 44 29 80 MOV [SI].FD_ORNOFS,REC_LENGTH + 854 0316 C6 44 2A 80 MOV [SI].FD_NMLOFS,REC_LENGTH + 855 031A 89 5C 22 MOV WORD PTR [SI].FD_FCB+FCB_RN,BX ;Set record number + 856 031D C7 44 24 0000 MOV WORD PTR [SI].FD_FCB+FCB_RN+2,0 + 857 + 858 0322 A8 04 TEST AL,DIRFLG ;Check if read + 859 0324 74 05 JZ get1 ; Yes - read + 860 + 861 0326 E8 035D R CALL WRITE_SECTOR ;Write it + 862 0329 EB 03 JMP SHORT pgret ;Done + 863 + 864 032B E8 0333 R get1: CALL READ_SECTOR ;Read it + 865 + 866 032E 5B pgret: POP BX + 867 032F 5A POP DX + 868 0330 59 POP CX + 869 0331 58 POP AX + 870 0332 C3 RET + 871 + 872 + 873 0333 devio_disk ENDP @@ -1322,193 +1322,193 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -874 -875 -876 ; Utility routines for disk I/O -877 -878 -879 0333 locals PROC NEAR -880 -881 -882 0333 READ_SECTOR: -883 0333 FF 44 27 INC [SI].FD_CURLOC ;Bump logical record number -884 -885 0336 51 PUSH CX -886 0337 57 PUSH DI -887 0338 B9 0040 MOV CX,REC_LENGTH/2 -888 033B 33 C0 XOR AX,AX -889 033D 8D 7C 33 LEA DI,[SI].FD_BUFFER -890 0340 F3/ AB REP STOSW ;Clear buffer -891 0342 5F POP DI -892 0343 59 POP CX -893 -894 0344 E8 038B R CALL SETBUF ;Set buffer address -895 0347 B4 21 MOV AH,C_RNDR -896 0349 E8 0397 R CALL ACCFIL ;Read random -897 034C 0A C0 OR AL,AL -898 034E B0 00 MOV AL,0 ;Length = 0 for end of file -899 0350 75 02 JNZ read1 -900 -901 0352 B0 80 MOV AL,REC_LENGTH ;Length = sector size -902 -903 0354 88 44 29 read1: MOV [SI].FD_ORNOFS,AL ;Set number bytes read -904 0357 88 44 2A MOV [SI].FD_NMLOFS,AL ;Set number of bytes left -905 035A 0A C0 OR AL,AL ;'Z' set if end of file -906 035C C3 RET -907 -908 -909 -910 035D WRITE_SECTOR: -911 035D C6 44 29 00 MOV [SI].FD_ORNOFS,0 ;Clear offset into buffer -912 0361 E8 038B R CALL SETBUF ;Set buffer address -913 0364 B4 22 MOV AH,C_RNDW -914 0366 E8 0397 R CALL ACCFIL ;Random write -915 0369 3C FF CMP AL,255 -916 036B 74 18 JE erctmf ;Too many files -917 036D FE C8 DEC AL -918 036F 74 17 JZ ercioe ;Error estending file -919 0371 FE C8 DEC AL -920 0373 75 0C JNZ write1 -921 -922 0375 88 04 MOV [SI].FD_MODE,AL ;Clear mode - disk full -923 0377 8D 54 01 LEA DX,[SI].FD_FCB -924 CALLOS C_CLOS ;Close file -925 037A B4 10 + MOV AH,C_CLOS -926 037C CD 21 + INT 33 -927 037E E9 0000 E JMP $ERC_DFL ;Disk full error + 874 + 875 + 876 ; Utility routines for disk I/O + 877 + 878 + 879 0333 locals PROC NEAR + 880 + 881 + 882 0333 READ_SECTOR: + 883 0333 FF 44 27 INC [SI].FD_CURLOC ;Bump logical record number + 884 + 885 0336 51 PUSH CX + 886 0337 57 PUSH DI + 887 0338 B9 0040 MOV CX,REC_LENGTH/2 + 888 033B 33 C0 XOR AX,AX + 889 033D 8D 7C 33 LEA DI,[SI].FD_BUFFER + 890 0340 F3/ AB REP STOSW ;Clear buffer + 891 0342 5F POP DI + 892 0343 59 POP CX + 893 + 894 0344 E8 038B R CALL SETBUF ;Set buffer address + 895 0347 B4 21 MOV AH,C_RNDR + 896 0349 E8 0397 R CALL ACCFIL ;Read random + 897 034C 0A C0 OR AL,AL + 898 034E B0 00 MOV AL,0 ;Length = 0 for end of file + 899 0350 75 02 JNZ read1 + 900 + 901 0352 B0 80 MOV AL,REC_LENGTH ;Length = sector size + 902 + 903 0354 88 44 29 read1: MOV [SI].FD_ORNOFS,AL ;Set number bytes read + 904 0357 88 44 2A MOV [SI].FD_NMLOFS,AL ;Set number of bytes left + 905 035A 0A C0 OR AL,AL ;'Z' set if end of file + 906 035C C3 RET + 907 + 908 + 909 + 910 035D WRITE_SECTOR: + 911 035D C6 44 29 00 MOV [SI].FD_ORNOFS,0 ;Clear offset into buffer + 912 0361 E8 038B R CALL SETBUF ;Set buffer address + 913 0364 B4 22 MOV AH,C_RNDW + 914 0366 E8 0397 R CALL ACCFIL ;Random write + 915 0369 3C FF CMP AL,255 + 916 036B 74 18 JE erctmf ;Too many files + 917 036D FE C8 DEC AL + 918 036F 74 17 JZ ercioe ;Error estending file + 919 0371 FE C8 DEC AL + 920 0373 75 0C JNZ write1 + 921 + 922 0375 88 04 MOV [SI].FD_MODE,AL ;Clear mode - disk full + 923 0377 8D 54 01 LEA DX,[SI].FD_FCB + 924 CALLOS C_CLOS ;Close file + 925 037A B4 10 + MOV AH,C_CLOS + 926 037C CD 21 + INT 33 + 927 037E E9 0000 E JMP $ERC_DFL ;Disk full error IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-2 -928 -929 0381 FF 44 27 write1: INC [SI].FD_CURLOC ;Bump current location -930 0384 C3 RET -931 -932 0385 E9 0000 E erctmf: JMP $ERC_TMF -933 -934 0388 E9 0000 E ercioe: JMP $ERC_IOE -935 -936 -937 -938 038B 51 SETBUF: PUSH CX ;Set buffer address -939 038C 52 PUSH DX -940 038D 8D 54 33 LEA DX,[SI].FD_BUFFER -941 CALLOS C_BUFF -942 0390 B4 1A + MOV AH,C_BUFF -943 0392 CD 21 + INT 33 -944 0394 5A POP DX -945 0395 59 POP CX -946 0396 C3 RET -947 -948 -949 -950 0397 51 ACCFIL: PUSH CX ;Access file -951 0398 52 PUSH DX -952 0399 8D 54 01 LEA DX,[SI].FD_FCB -953 CALLOS ;Call operating system -954 039C CD 21 + INT 33 -955 039E FF 44 22 INC WORD PTR [SI].FD_FCB+FCB_RN ;Bump record number -956 03A1 75 03 JNZ accfl1 -957 03A3 FF 44 24 INC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Bump high order bytes -958 03A6 80 FC 22 accfl1: CMP AH,C_RNDW -959 03A9 75 12 JNE accfl2 -960 03AB 0A C0 OR AL,AL -961 03AD 74 14 JZ accret ;No error -962 03AF 3C 05 CMP AL,5 -963 03B1 74 D2 JE erctmf ;5 - Too many files -964 03B3 3C 03 CMP AL,3 -965 03B5 B0 01 MOV AL,1 ;Map 3 to 1 -966 03B7 74 0A JE accret -967 03B9 FE C0 INC AL ;Disk space full -968 03BB EB 06 JMP SHORT accret -969 -970 03BD accfl2: -971 if _MSDOS_ -972 03BD 3C 03 CMP AL,3 ;Test for partial sector read -973 03BF 75 02 JNE accret -974 03C1 32 C0 XOR AL,AL ;Map 3 to 0 (no error) -975 endif -976 03C3 5A accret: POP DX -977 03C4 59 POP CX -978 03C5 C3 RET -979 -980 -981 + 928 + 929 0381 FF 44 27 write1: INC [SI].FD_CURLOC ;Bump current location + 930 0384 C3 RET + 931 + 932 0385 E9 0000 E erctmf: JMP $ERC_TMF + 933 + 934 0388 E9 0000 E ercioe: JMP $ERC_IOE + 935 + 936 + 937 + 938 038B 51 SETBUF: PUSH CX ;Set buffer address + 939 038C 52 PUSH DX + 940 038D 8D 54 33 LEA DX,[SI].FD_BUFFER + 941 CALLOS C_BUFF + 942 0390 B4 1A + MOV AH,C_BUFF + 943 0392 CD 21 + INT 33 + 944 0394 5A POP DX + 945 0395 59 POP CX + 946 0396 C3 RET + 947 + 948 + 949 + 950 0397 51 ACCFIL: PUSH CX ;Access file + 951 0398 52 PUSH DX + 952 0399 8D 54 01 LEA DX,[SI].FD_FCB + 953 CALLOS ;Call operating system + 954 039C CD 21 + INT 33 + 955 039E FF 44 22 INC WORD PTR [SI].FD_FCB+FCB_RN ;Bump record number + 956 03A1 75 03 JNZ accfl1 + 957 03A3 FF 44 24 INC WORD PTR [SI].FD_FCB+FCB_RN+2 ;Bump high order bytes + 958 03A6 80 FC 22 accfl1: CMP AH,C_RNDW + 959 03A9 75 12 JNE accfl2 + 960 03AB 0A C0 OR AL,AL + 961 03AD 74 14 JZ accret ;No error + 962 03AF 3C 05 CMP AL,5 + 963 03B1 74 D2 JE erctmf ;5 - Too many files + 964 03B3 3C 03 CMP AL,3 + 965 03B5 B0 01 MOV AL,1 ;Map 3 to 1 + 966 03B7 74 0A JE accret + 967 03B9 FE C0 INC AL ;Disk space full + 968 03BB EB 06 JMP SHORT accret + 969 + 970 03BD accfl2: + 971 if _MSDOS_ + 972 03BD 3C 03 CMP AL,3 ;Test for partial sector read + 973 03BF 75 02 JNE accret + 974 03C1 32 C0 XOR AL,AL ;Map 3 to 0 (no error) + 975 endif + 976 03C3 5A accret: POP DX + 977 03C4 59 POP CX + 978 03C5 C3 RET + 979 + 980 + 981 IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-3 -982 03C6 50 NAMFIL: PUSH AX -983 03C7 51 PUSH CX -984 03C8 56 PUSH SI -985 03C9 8B 0F MOV CX,[BX] ;(CX) = string length -986 03CB 8B 77 02 MOV SI,[BX+2] ;(SI) = string address -987 03CE E8 0000 E CALL $SCANF ;Scan file name -988 03D1 A8 80 TEST AL,80h ;Check for special devices -989 03D3 78 07 JS ercbfn ;Illegal device name (only disk) -990 03D5 E8 0000 E CALL $$DITS ;Delete temporary strings -991 03D8 5E POP SI -992 03D9 59 POP CX -993 03DA 58 POP AX -994 03DB C3 RET -995 -996 03DC E9 0000 E ercbfn: JMP $ERC_BFN -997 -998 -999 -1000 if _MSDOS_ -1001 ;** CHKFOP - Check for file already open -1002 ; -1003 ; ENTRY (SI) = file data block pointer -1004 ; USES AX -1005 -1006 03DF 57 CHKFOP: PUSH DI -1007 03E0 80 7C 01 00 CMP [SI].FD_FCB,0 ;Default drive? -1008 03E4 75 09 JNE ntcdrv ; No -1009 -1010 CALLOS C_GDRV ;Get drive number -1011 03E6 B4 19 + MOV AH,C_GDRV -1012 03E8 CD 21 + INT 33 -1013 03EA FE C0 INC AL ; Convert to A=1, etc. -1014 03EC 88 44 01 MOV [SI].FD_FCB,AL ;Save drive number -1015 -1016 03EF BF 0002 E ntcdrv: MOV DI,OFFSET DC:$FILPT-BL_LNK ;Must link through open file list -1017 -1018 03F2 8B 7D FE chklop: MOV DI,[DI].BL_LNK ;Chain to next entry -1019 03F5 0B FF OR DI,DI ;Test for end of list -1020 03F7 74 14 JE chkret ; Done -1021 -1022 03F9 3B F7 CMP SI,DI ;Same file? -1023 03FB 74 F5 JE chklop ; Yes - skip this one -1024 -1025 03FD 56 PUSH SI -1026 03FE 57 PUSH DI -1027 03FF 46 INC SI ;Point to FCB's -1028 0400 47 INC DI -1029 0401 B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive -1030 0404 F3/ A6 REPZ CMPSB ;Compare strings -1031 0406 5F POP DI -1032 0407 5E POP SI -1033 0408 75 E8 JNE chklop ;Not equal - keep going -1034 -1035 040A E9 0000 E JMP $ERC_FAO ;File already open + 982 03C6 50 NAMFIL: PUSH AX + 983 03C7 51 PUSH CX + 984 03C8 56 PUSH SI + 985 03C9 8B 0F MOV CX,[BX] ;(CX) = string length + 986 03CB 8B 77 02 MOV SI,[BX+2] ;(SI) = string address + 987 03CE E8 0000 E CALL $SCANF ;Scan file name + 988 03D1 A8 80 TEST AL,80h ;Check for special devices + 989 03D3 78 07 JS ercbfn ;Illegal device name (only disk) + 990 03D5 E8 0000 E CALL $$DITS ;Delete temporary strings + 991 03D8 5E POP SI + 992 03D9 59 POP CX + 993 03DA 58 POP AX + 994 03DB C3 RET + 995 + 996 03DC E9 0000 E ercbfn: JMP $ERC_BFN + 997 + 998 + 999 + 1000 if _MSDOS_ + 1001 ;** CHKFOP - Check for file already open + 1002 ; + 1003 ; ENTRY (SI) = file data block pointer + 1004 ; USES AX + 1005 + 1006 03DF 57 CHKFOP: PUSH DI + 1007 03E0 80 7C 01 00 CMP [SI].FD_FCB,0 ;Default drive? + 1008 03E4 75 09 JNE ntcdrv ; No + 1009 + 1010 CALLOS C_GDRV ;Get drive number + 1011 03E6 B4 19 + MOV AH,C_GDRV + 1012 03E8 CD 21 + INT 33 + 1013 03EA FE C0 INC AL ; Convert to A=1, etc. + 1014 03EC 88 44 01 MOV [SI].FD_FCB,AL ;Save drive number + 1015 + 1016 03EF BF 0002 E ntcdrv: MOV DI,OFFSET DC:$FILPT-BL_LNK ;Must link through open file list + 1017 + 1018 03F2 8B 7D FE chklop: MOV DI,[DI].BL_LNK ;Chain to next entry + 1019 03F5 0B FF OR DI,DI ;Test for end of list + 1020 03F7 74 14 JE chkret ; Done + 1021 + 1022 03F9 3B F7 CMP SI,DI ;Same file? + 1023 03FB 74 F5 JE chklop ; Yes - skip this one + 1024 + 1025 03FD 56 PUSH SI + 1026 03FE 57 PUSH DI + 1027 03FF 46 INC SI ;Point to FCB's + 1028 0400 47 INC DI + 1029 0401 B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive + 1030 0404 F3/ A6 REPZ CMPSB ;Compare strings + 1031 0406 5F POP DI + 1032 0407 5E POP SI + 1033 0408 75 E8 JNE chklop ;Not equal - keep going + 1034 + 1035 040A E9 0000 E JMP $ERC_FAO ;File already open IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 3-4 -1036 -1037 040D 5F chkret: POP DI -1038 040E C3 RET -1039 endif -1040 -1041 -1042 040F locals ENDP + 1036 + 1037 040D 5F chkret: POP DI + 1038 040E C3 RET + 1039 endif + 1040 + 1041 + 1042 040F locals ENDP @@ -1562,256 +1562,256 @@ IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:3 -1043 -1044 -1045 ; Compiler Generated Library Calls -1046 -1047 040F entries PROC NEAR -1048 -1049 -1050 ;** $FL0 and $FIL - FILES statement -1051 -1052 ;** $FL0 -1053 ; -1054 ; ENTRY NONE -1055 ; EXIT NONE -1056 -1057 040F E8 0000 E $FL0: CALL $SAVREG -1058 0412 BB 0000 E MOV BX,OFFSET DC:$FILNAM -1059 0415 C6 07 00 MOV BYTE PTR [BX],0 ;Select default drive -1060 0418 43 INC BX -1061 0419 B1 0B MOV CL,11 -1062 041B E8 050D R CALL FILQST ;Fill name with ? -1063 041E EB 06 JMP SHORT fil01 ;Go to common code -1064 -1065 -1066 ;** $FIL -1067 ; -1068 ; ENTRY (BX) = filename sdesc -1069 ; USES NONE -1070 -1071 0420 E8 0000 E $FIL: CALL $SAVREG -1072 0423 E8 03C6 R CALL NAMFIL ;Scan file name -1073 0426 fil01: -1074 0426 C6 06 000C E 00 MOV BYTE PTR [$FILNAM+12],0 ;Clear extent byte -1075 042B BB 0001 E MOV BX,OFFSET DC:$FILNAM+1 ;Point to filename -1076 042E B1 08 MOV CL,8 -1077 0430 E8 0508 R CALL FILQS -1078 0433 BB 0009 E MOV BX,OFFSET DC:$FILNAM+9 ;Point to extension -1079 0436 B1 03 MOV CL,3 -1080 0438 E8 0508 R CALL FILQS -1081 if _MSDOS_ -1082 043B BA 0000 E MOV DX,OFFSET DC:$FILNM2 ;For MSDOS -1083 else -1084 MOV DX,OFFSET DC:$DIRTMP ;For CPM -1085 endif -1086 CALLOS C_BUFF ;Set buffer address -1087 043E B4 1A + MOV AH,C_BUFF -1088 0440 CD 21 + INT 33 -1089 0442 BA 0000 E MOV DX,OFFSET DC:$FILNAM -1090 CALLOS C_SEAR ;Search for filename -1091 0445 B4 11 + MOV AH,C_SEAR -1092 0447 CD 21 + INT 33 -1093 0449 3C FF CMP AL,255 ;Test for 1st occurence of file -1094 044B 74 63 JZ ercfnf ; Not found -1095 -1096 044D BE 0001 E filnxt: MOV SI,OFFSET DC:$FILNM2+1 ;Point to file name + 1043 + 1044 + 1045 ; Compiler Generated Library Calls + 1046 + 1047 040F entries PROC NEAR + 1048 + 1049 + 1050 ;** $FL0 and $FIL - FILES statement + 1051 + 1052 ;** $FL0 + 1053 ; + 1054 ; ENTRY NONE + 1055 ; EXIT NONE + 1056 + 1057 040F E8 0000 E $FL0: CALL $SAVREG + 1058 0412 BB 0000 E MOV BX,OFFSET DC:$FILNAM + 1059 0415 C6 07 00 MOV BYTE PTR [BX],0 ;Select default drive + 1060 0418 43 INC BX + 1061 0419 B1 0B MOV CL,11 + 1062 041B E8 050D R CALL FILQST ;Fill name with ? + 1063 041E EB 06 JMP SHORT fil01 ;Go to common code + 1064 + 1065 + 1066 ;** $FIL + 1067 ; + 1068 ; ENTRY (BX) = filename sdesc + 1069 ; USES NONE + 1070 + 1071 0420 E8 0000 E $FIL: CALL $SAVREG + 1072 0423 E8 03C6 R CALL NAMFIL ;Scan file name + 1073 0426 fil01: + 1074 0426 C6 06 000C E 00 MOV BYTE PTR [$FILNAM+12],0 ;Clear extent byte + 1075 042B BB 0001 E MOV BX,OFFSET DC:$FILNAM+1 ;Point to filename + 1076 042E B1 08 MOV CL,8 + 1077 0430 E8 0508 R CALL FILQS + 1078 0433 BB 0009 E MOV BX,OFFSET DC:$FILNAM+9 ;Point to extension + 1079 0436 B1 03 MOV CL,3 + 1080 0438 E8 0508 R CALL FILQS + 1081 if _MSDOS_ + 1082 043B BA 0000 E MOV DX,OFFSET DC:$FILNM2 ;For MSDOS + 1083 else + 1084 MOV DX,OFFSET DC:$DIRTMP ;For CPM + 1085 endif + 1086 CALLOS C_BUFF ;Set buffer address + 1087 043E B4 1A + MOV AH,C_BUFF + 1088 0440 CD 21 + INT 33 + 1089 0442 BA 0000 E MOV DX,OFFSET DC:$FILNAM + 1090 CALLOS C_SEAR ;Search for filename + 1091 0445 B4 11 + MOV AH,C_SEAR + 1092 0447 CD 21 + INT 33 + 1093 0449 3C FF CMP AL,255 ;Test for 1st occurence of file + 1094 044B 74 63 JZ ercfnf ; Not found + 1095 + 1096 044D BE 0001 E filnxt: MOV SI,OFFSET DC:$FILNM2+1 ;Point to file name IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-2 -1097 0450 B9 000B MOV CX,11 ;Characters in name -1098 -1099 0453 AC mornam: LODSB ;Get character -1100 0454 E8 0000 E CALL $$WCHT ;Output it -1101 0457 83 F9 04 CMP CX,4 -1102 045A 75 0B JNE notext ;Not an extension break -1103 -1104 045C 8A 04 MOV AL,[SI] ;Get 1st char of extension -1105 045E 3C 20 CMP AL,' ' -1106 0460 74 02 JE prispa ;Blank extension - print space -1107 -1108 0462 B0 2E MOV AL,'.' ;Print . -1109 -1110 0464 E8 0000 E prispa: CALL $$WCHT ;Print blank or dot -1111 -1112 0467 E2 EA notext: LOOP mornam ;Loop until 11 characters -1113 -1114 0469 E8 0000 E CALL $TTY_GPOS ;Get TTY position -1115 046C 86 C4 XCHG AL,AH -1116 046E 04 0E ADD AL,14-_IBM_ ;Position after next file name -1117 0470 E8 0000 E CALL $TTY_GWID ;Get TTY width -1118 0473 3A C4 CMP AL,AH -1119 0475 73 0A JAE nwfiln ;Force CR/LF -1120 -1121 0477 B0 20 MOV AL,' ' -1122 ife _IBM_ -1123 0479 E8 0000 E CALL $$WCHT -1124 endif -1125 047C E8 0000 E CALL $$WCHT -1126 047F EB 03 JMP SHORT nextfl -1127 -1128 0481 E8 0000 E nwfiln: CALL $$TCR ;Type CR/LF -1129 -1130 0484 BA 0000 E nextfl: MOV DX,OFFSET DC:$FILNAM -1131 CALLOS C_SEAR+1 -1132 0487 B4 12 + MOV AH,C_SEAR+1 -1133 0489 CD 21 + INT 33 -1134 048B 3C FF CMP AL,255 -1135 048D 75 BE JNE filnxt ;Still more -1136 -1137 048F C3 nwfil2: RET -1138 -1139 -1140 -1141 ;** $DKK - KILL filename -1142 ; -1143 ; ENTRY (BX) = filename sdesc -1144 ; USES NONE -1145 -1146 0490 E8 0000 E $DKK: CALL $SAVREG -1147 0493 E8 03C6 R CALL NAMFIL ;Scan file name -1148 if _CPM_ -1149 MOV DX,OFFSET DC:$DIRTMP ;Temporary buffer -1150 CALLOS C_BUFF ;Set buffer address + 1097 0450 B9 000B MOV CX,11 ;Characters in name + 1098 + 1099 0453 AC mornam: LODSB ;Get character + 1100 0454 E8 0000 E CALL $$WCHT ;Output it + 1101 0457 83 F9 04 CMP CX,4 + 1102 045A 75 0B JNE notext ;Not an extension break + 1103 + 1104 045C 8A 04 MOV AL,[SI] ;Get 1st char of extension + 1105 045E 3C 20 CMP AL,' ' + 1106 0460 74 02 JE prispa ;Blank extension - print space + 1107 + 1108 0462 B0 2E MOV AL,'.' ;Print . + 1109 + 1110 0464 E8 0000 E prispa: CALL $$WCHT ;Print blank or dot + 1111 + 1112 0467 E2 EA notext: LOOP mornam ;Loop until 11 characters + 1113 + 1114 0469 E8 0000 E CALL $TTY_GPOS ;Get TTY position + 1115 046C 86 C4 XCHG AL,AH + 1116 046E 04 0E ADD AL,14-_IBM_ ;Position after next file name + 1117 0470 E8 0000 E CALL $TTY_GWID ;Get TTY width + 1118 0473 3A C4 CMP AL,AH + 1119 0475 73 0A JAE nwfiln ;Force CR/LF + 1120 + 1121 0477 B0 20 MOV AL,' ' + 1122 ife _IBM_ + 1123 0479 E8 0000 E CALL $$WCHT + 1124 endif + 1125 047C E8 0000 E CALL $$WCHT + 1126 047F EB 03 JMP SHORT nextfl + 1127 + 1128 0481 E8 0000 E nwfiln: CALL $$TCR ;Type CR/LF + 1129 + 1130 0484 BA 0000 E nextfl: MOV DX,OFFSET DC:$FILNAM + 1131 CALLOS C_SEAR+1 + 1132 0487 B4 12 + MOV AH,C_SEAR+1 + 1133 0489 CD 21 + INT 33 + 1134 048B 3C FF CMP AL,255 + 1135 048D 75 BE JNE filnxt ;Still more + 1136 + 1137 048F C3 nwfil2: RET + 1138 + 1139 + 1140 + 1141 ;** $DKK - KILL filename + 1142 ; + 1143 ; ENTRY (BX) = filename sdesc + 1144 ; USES NONE + 1145 + 1146 0490 E8 0000 E $DKK: CALL $SAVREG + 1147 0493 E8 03C6 R CALL NAMFIL ;Scan file name + 1148 if _CPM_ + 1149 MOV DX,OFFSET DC:$DIRTMP ;Temporary buffer + 1150 CALLOS C_BUFF ;Set buffer address IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-3 -1151 endif -1152 0496 BA 0000 E MOV DX,OFFSET DC:$FILNAM -1153 CALLOS C_OPEN ;Open file -1154 0499 B4 0F + MOV AH,C_OPEN -1155 049B CD 21 + INT 33 -1156 049D FE C0 INC AL -1157 049F 74 0F JZ ercfnf ;File not found -1158 CALLOS C_CLOS ;Close file -1159 04A1 B4 10 + MOV AH,C_CLOS -1160 04A3 CD 21 + INT 33 -1161 if _MSDOS_ -1162 04A5 BE FFFF E MOV SI,OFFSET DC:$FILNAM-1 ;Pretend we are FDB -1163 04A8 E8 03DF R CALL CHKFOP ;Check for conflict with open files -1164 endif -1165 CALLOS C_DELE ;Delete file -1166 04AB B4 13 + MOV AH,C_DELE -1167 04AD CD 21 + INT 33 -1168 04AF C3 RET -1169 -1170 04B0 E9 0000 E ercfnf: JMP $ERC_FNF ;File not found -1171 -1172 -1173 -1174 ;** $DKR - NAME statement -1175 ; -1176 ; ENTRY (BX) = source name -1177 ; (DX) = dest name -1178 ; EXIT NONE -1179 -1180 04B3 E8 0000 E $DKR: CALL $SAVREG -1181 04B6 52 PUSH DX ;Save dest name -1182 04B7 E8 03C6 R CALL NAMFIL ;Scan old file name -1183 04BA BA 0000 E MOV DX,OFFSET DC:$FILNAM -1184 CALLOS C_OPEN -1185 04BD B4 0F + MOV AH,C_OPEN -1186 04BF CD 21 + INT 33 -1187 04C1 FE C0 INC AL -1188 04C3 74 EB JZ ercfnf ;File not found -1189 04C5 8B F2 MOV SI,DX -1190 04C7 BF 0000 E MOV DI,OFFSET DC:$FILNM2 -1191 04CA B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive -1192 04CD F3/ A4 REP MOVSB ;Move name -1193 04CF 5B POP BX ;Pop dest name -1194 04D0 E8 03C6 R CALL NAMFIL ;Scan new filename -1195 CALLOS C_OPEN -1196 04D3 B4 0F + MOV AH,C_OPEN -1197 04D5 CD 21 + INT 33 -1198 04D7 FE C0 INC AL -1199 04D9 75 13 JNZ ercfae ;File already exists -1200 -1201 if _CPM_ -1202 MOV AL,[$FILNAM] ;Test to see if drives match -1203 CMP [$FILNM2],AL -1204 JE drvsok + 1151 endif + 1152 0496 BA 0000 E MOV DX,OFFSET DC:$FILNAM + 1153 CALLOS C_OPEN ;Open file + 1154 0499 B4 0F + MOV AH,C_OPEN + 1155 049B CD 21 + INT 33 + 1156 049D FE C0 INC AL + 1157 049F 74 0F JZ ercfnf ;File not found + 1158 CALLOS C_CLOS ;Close file + 1159 04A1 B4 10 + MOV AH,C_CLOS + 1160 04A3 CD 21 + INT 33 + 1161 if _MSDOS_ + 1162 04A5 BE FFFF E MOV SI,OFFSET DC:$FILNAM-1 ;Pretend we are FDB + 1163 04A8 E8 03DF R CALL CHKFOP ;Check for conflict with open files + 1164 endif + 1165 CALLOS C_DELE ;Delete file + 1166 04AB B4 13 + MOV AH,C_DELE + 1167 04AD CD 21 + INT 33 + 1168 04AF C3 RET + 1169 + 1170 04B0 E9 0000 E ercfnf: JMP $ERC_FNF ;File not found + 1171 + 1172 + 1173 + 1174 ;** $DKR - NAME statement + 1175 ; + 1176 ; ENTRY (BX) = source name + 1177 ; (DX) = dest name + 1178 ; EXIT NONE + 1179 + 1180 04B3 E8 0000 E $DKR: CALL $SAVREG + 1181 04B6 52 PUSH DX ;Save dest name + 1182 04B7 E8 03C6 R CALL NAMFIL ;Scan old file name + 1183 04BA BA 0000 E MOV DX,OFFSET DC:$FILNAM + 1184 CALLOS C_OPEN + 1185 04BD B4 0F + MOV AH,C_OPEN + 1186 04BF CD 21 + INT 33 + 1187 04C1 FE C0 INC AL + 1188 04C3 74 EB JZ ercfnf ;File not found + 1189 04C5 8B F2 MOV SI,DX + 1190 04C7 BF 0000 E MOV DI,OFFSET DC:$FILNM2 + 1191 04CA B9 000C MOV CX,FILNAM_LENGTH+1 ;+1 for drive + 1192 04CD F3/ A4 REP MOVSB ;Move name + 1193 04CF 5B POP BX ;Pop dest name + 1194 04D0 E8 03C6 R CALL NAMFIL ;Scan new filename + 1195 CALLOS C_OPEN + 1196 04D3 B4 0F + MOV AH,C_OPEN + 1197 04D5 CD 21 + INT 33 + 1198 04D7 FE C0 INC AL + 1199 04D9 75 13 JNZ ercfae ;File already exists + 1200 + 1201 if _CPM_ + 1202 MOV AL,[$FILNAM] ;Test to see if drives match + 1203 CMP [$FILNM2],AL + 1204 JE drvsok IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-4 -1205 JMP $ERC_FC ;Illegal function call -1206 drvsok: -1207 endif -1208 -1209 if _MSDOS_ -1210 04DB 8B F2 MOV SI,DX -1211 04DD 46 INC SI ;(SI) = $FILNAM+1 -1212 04DE BF 0011 E MOV DI,OFFSET DC:$FILNM2+17 ;(DI) = dest for new file name -1213 04E1 B9 000B MOV CX,FILNAM_LENGTH ;No drive code -1214 04E4 F3/ A4 REP MOVSB ;Move name -1215 endif -1216 -1217 04E6 BA 0000 E MOV DX,OFFSET DC:$FILNM2 ;Point to 2nd FCB -1218 CALLOS C_RENA ;Rename file -1219 04E9 B4 17 + MOV AH,C_RENA -1220 04EB CD 21 + INT 33 -1221 04ED C3 RET -1222 -1223 04EE E9 0000 E ercfae: JMP $ERC_FAE ;File already exists -1224 -1225 -1226 -1227 ;** $RS2 - RESET statement; -1228 ; -1229 ; ENTRY NONE -1230 ; EXIT NONE -1231 -1232 04F1 $ZZ1: -1233 04F1 E8 0000 E $RS2: CALL $SAVREG -1234 04F4 E8 0000 E CALL $CLOSF ;Close all files -1235 CALLOS C_GDRV ;Get drive number -1236 04F7 B4 19 + MOV AH,C_GDRV -1237 04F9 CD 21 + INT 33 -1238 04FB 50 PUSH AX -1239 CALLOS C_REST ;Restore -1240 04FC B4 0D + MOV AH,C_REST -1241 04FE CD 21 + INT 33 -1242 0500 58 POP AX -1243 0501 8A D0 MOV DL,AL -1244 CALLOS C_SDRV ;Set drive number -1245 0503 B4 0E + MOV AH,C_SDRV -1246 0505 CD 21 + INT 33 -1247 0507 C3 RET -1248 -1249 -1250 0508 entries ENDP -1251 -1252 0508 filprc PROC NEAR -1253 -1254 0508 80 3F 2A filqs: CMP BYTE PTR [BX],'*' ;Test for * -1255 050B 75 08 JNE filret -1256 -1257 050D C6 07 3F filqst: MOV BYTE PTR [BX],'?' ;Fill with ? -1258 0510 43 INC BX + 1205 JMP $ERC_FC ;Illegal function call + 1206 drvsok: + 1207 endif + 1208 + 1209 if _MSDOS_ + 1210 04DB 8B F2 MOV SI,DX + 1211 04DD 46 INC SI ;(SI) = $FILNAM+1 + 1212 04DE BF 0011 E MOV DI,OFFSET DC:$FILNM2+17 ;(DI) = dest for new file name + 1213 04E1 B9 000B MOV CX,FILNAM_LENGTH ;No drive code + 1214 04E4 F3/ A4 REP MOVSB ;Move name + 1215 endif + 1216 + 1217 04E6 BA 0000 E MOV DX,OFFSET DC:$FILNM2 ;Point to 2nd FCB + 1218 CALLOS C_RENA ;Rename file + 1219 04E9 B4 17 + MOV AH,C_RENA + 1220 04EB CD 21 + INT 33 + 1221 04ED C3 RET + 1222 + 1223 04EE E9 0000 E ercfae: JMP $ERC_FAE ;File already exists + 1224 + 1225 + 1226 + 1227 ;** $RS2 - RESET statement; + 1228 ; + 1229 ; ENTRY NONE + 1230 ; EXIT NONE + 1231 + 1232 04F1 $ZZ1: + 1233 04F1 E8 0000 E $RS2: CALL $SAVREG + 1234 04F4 E8 0000 E CALL $CLOSF ;Close all files + 1235 CALLOS C_GDRV ;Get drive number + 1236 04F7 B4 19 + MOV AH,C_GDRV + 1237 04F9 CD 21 + INT 33 + 1238 04FB 50 PUSH AX + 1239 CALLOS C_REST ;Restore + 1240 04FC B4 0D + MOV AH,C_REST + 1241 04FE CD 21 + INT 33 + 1242 0500 58 POP AX + 1243 0501 8A D0 MOV DL,AL + 1244 CALLOS C_SDRV ;Set drive number + 1245 0503 B4 0E + MOV AH,C_SDRV + 1246 0505 CD 21 + INT 33 + 1247 0507 C3 RET + 1248 + 1249 + 1250 0508 entries ENDP + 1251 + 1252 0508 filprc PROC NEAR + 1253 + 1254 0508 80 3F 2A filqs: CMP BYTE PTR [BX],'*' ;Test for * + 1255 050B 75 08 JNE filret + 1256 + 1257 050D C6 07 3F filqst: MOV BYTE PTR [BX],'?' ;Fill with ? + 1258 0510 43 INC BX IODISK - Disk I/O Drivers for BASCOM-86 Macro-86 %1(12) 1:4:30 13-Nov-81 Page 4-5 -1259 0511 FE C9 DEC CL -1260 0513 75 F8 JNZ filqst ;Keep looping -1261 -1262 0515 C3 filret: RET -1263 -1264 0516 filprc ENDP -1265 -1266 0516 CODE ENDS -1267 -1268 END + 1259 0511 FE C9 DEC CL + 1260 0513 75 F8 JNZ filqst ;Keep looping + 1261 + 1262 0515 C3 filret: RET + 1263 + 1264 0516 filprc ENDP + 1265 + 1266 0516 CODE ENDS + 1267 + 1268 END From 8dadb6e2252ee419a3226dd95032a44340159cc2 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 16 Jul 2026 17:48:52 -0700 Subject: [PATCH 36/53] Transcription of Bundle 9 - IOFILM.ASM Code and Listing --- 2_printed_files/bundle_09/IOFILM.ASM | 720 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/IOFILM.ASM | 172 +++++++ 2 files changed, 892 insertions(+) create mode 100644 2_printed_files/bundle_09/IOFILM.ASM create mode 100644 3_source_code/BASLIB-86/IOFILM.ASM diff --git a/2_printed_files/bundle_09/IOFILM.ASM b/2_printed_files/bundle_09/IOFILM.ASM new file mode 100644 index 0000000..76b4f0f --- /dev/null +++ b/2_printed_files/bundle_09/IOFILM.ASM @@ -0,0 +1,720 @@ +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-1 + + + + 1 TITLE IOFILM - File Manager for BASCOM-86 + 2 PAGE 60,132 + 3 ; This module contains the dynamic file management routines for the + 4 ; 8086 BASIC Compiler runtime. + 5 + 6 C INCLUDE TABMAC.INC + 7 C ; Special Table Generation Macros + 8 C + 9 C ENTORG MACRO First_entry + 10 C .XCREF + 11 C ___ZZZ= First_entry + 12 C .CREF + 13 C ENDM + 14 C + 15 C + 16 C ENT MACRO Lab,Incr + 17 C Lab= ___ZZZ + 18 C .XCREF + 19 C ___ZZZ= ___ZZZ+Incr + 20 C .CREF + 21 C ENDM + 22 C + 23 C + 24 C ENTI MACRO Incr + 25 C .XCREF + 26 C ___ZZZ= ___ZZZ+Incr + 27 C .CREF + 28 C ENDM + 29 C + 30 + 31 + 32 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 33 + 34 EXTRN $FILPT:WORD ;File block list head + 35 EXTRN $FREPT:WORD ;File block list head + 36 + 37 C INCLUDE DEVDEF.INC + + + + + + + + + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-2 + + + + 38 C PAGE + 39 C + 40 C ; DEVDEF.INC - Device Independent I/O Definitions + 41 C + 42 C INCLUDE SYSTEM.INC + 43 C ; Operating System Selection + 44 C + 45 = 0000 C _IBM_= 0 + 46 C + 47 = 0001 C _MSDOS_= 1 + 48 = 0000 C _CPM_= 0 + 49 C + 50 C ; Overrides + 51 C + 52 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ + 53 C + 54 C if1 + 55 C if _CPM_ + 56 C %OUT ! CP/M-86 Version + 57 C endif + 58 C if _MSDOS_ + 59 C %OUT ! MSDOS Version + 60 C endif + 61 C if _IBM_ + 62 C %OUT ! IBM Personal Computer + 63 C endif + 64 C + 65 C if _MSDOS_+_CPM_ ne 1 + 66 C %OUT ##################### Error - Bad Operating System Selection + 67 C + 68 C error + 69 C endif + 70 C endif + 71 C + + + + + + + + + + + + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-3 + + + + 72 C PAGE + 73 C + 74 C DEVNAM MACRO + 75 C DEVMAC KYBD + 76 C DEVMAC SCRN + 77 C if _IBM_ + 78 C DEVMAC CAS1 + 79 C DEVMAC COM1 + 80 C DEVMAC COM2 + 81 C endif + 82 C DEVMAC LPT1 + 83 C if _IBM_ + 84 C DEVMAC LPT2 + 85 C DEVMAC LPT3 + 86 C endif + 87 C ENDM + 88 C + 89 = FFFF C ___DEV= -1 + 90 C + 91 C DEVMAC MACRO ARG + 92 C DN_&ARG= ___DEV + 93 C .xcref + 94 C ___DEV= ___DEV-1 + 95 C .cref + 96 C ENDM + 97 C + 98 C DEVNAM + 99 C + 100 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-4 + + + + 101 C PAGE + 102 C + 103 C DSPNAM MACRO + 104 C DSPMAC EOF ;EOF function + 105 C DSPMAC LOC ;LOC function + 106 C DSPMAC LOF ;LOF function + 107 C ; DSPMAC POS ;POS function + 108 C DSPMAC CLOSE ;CLOSE statement + 109 C DSPMAC WIDTH ;WIDTH statement + 110 C DSPMAC RANDIO ;GET/PUT statements + 111 C DSPMAC OPEN ;OPEN statement + 112 C DSPMAC BAKC ;Backup character + 113 C DSPMAC SINP ;Serial input + 114 C DSPMAC SOUT ;Serial output + 115 C DSPMAC GPOS ;Get current position + 116 C DSPMAC GWID ;Get current width + 117 C ENDM + 118 C + 119 C + 120 C ; Device Function Dispatch Table Offsets + 121 C + 122 C + 123 C DSPMAC MACRO func + 124 C ENT DV_&func,2 + 125 C ENDM + 126 C + 127 C + 128 C ENTORG 0 + 129 C DSPNAM + 130 C ENT DV_TABLEN,0 + 131 C + + + + + + + + + + + + + + + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-5 + + + + 132 C PAGE + 133 C + 134 C ; File Mode Definitions + 135 C + 136 = 0001 C MD_SQI EQU 1 + 137 = 0002 C MD_SQO EQU 2 + 138 = 0004 C MD_RND EQU 4 + 139 = 0004 C MD_FIL EQU 4 + 140 = 0008 C MD_APP EQU 8 + 141 = 0010 C MD_KIL EQU 16 + 142 = 0020 C MD_IBM EQU 32 + 143 = 0040 C MD_USR EQU 64 + 144 = 0080 C MD_BIN EQU 128 + 145 C + 146 C + 147 C ; Operating System dependent field sizes + 148 C + 149 = 001A C EOFCHR= 'Z' and 1fh + 150 C + 151 = 0026 C FILNAML= 38 ;Length of $FILNAM + 152 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) + 153 C + 154 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs + 155 = 0080 C REC_LENGTH= 128 ;128 byte sectors + 156 C + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-6 + + + + 157 C PAGE + 158 C + 159 C ;----- Basic Interpreter style File Data Block ----- + 160 C + 161 C ; Link block offsets + 162 C + 163 =-0006 C BL_SIZE= -6 ;Link block size (2 bytes of misc) + 164 =-0005 C FB_NUM= -5 ; File number + 165 =-0004 C BL_LEN= -4 ;Block size + 166 =-0002 C BL_LNK= -2 ;Block link + 167 C + 168 C ; File Data Block offsets + 169 C + 170 C FILE_DATA_BLOCK STRUC + 171 C + 172 0000 ?? C FD_MODE DB ? ;File mode of open + 173 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area + 174 ?? C + 175 ] C + 176 C + 177 0027 ???? C FD_CURLOC DW ? ;Current record number + 178 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector + 179 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer + 180 002B 03 [ C DB 3 DUP (?) ;Unused + 181 ?? C + 182 ] C + 183 C + 184 002E ?? C FD_DEVICE DB ? ;Device number + 185 002F ?? C FD_WIDTH DB ? ;File width + 186 0030 ?? C FD_POS DB ? ;Current file position + 187 0031 ?? C FD_FLAGS DB ? ;Used for load and save + 188 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion + 189 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer + 190 ?? C + 191 ] C + 192 C + 193 C + 194 C ; 5.0 Variable Record Information + 195 C + 196 00B3 ???? C FR_VRECL DW ? ;Variable record length + 197 00B5 ???? C FR_PHYREC DW ? ;Current physical record number + 198 00B7 ???? C FR_LOGREC DW ? ;Current logical record number + 199 00B9 ?? C DB ? ;Future use + 200 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O + 201 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer + 202 ?? C + 203 ] C + 204 C + 205 C + 206 00BD C FILE_DATA_BLOCK ENDS + 207 C + 208 C + 209 C ; End of DEVDEF.INC + 210 + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 1-7 + + + + 211 0000 DATA ENDS + 212 + 213 DC GROUP DATA + 214 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 2-1 + + + + 215 + 216 + 217 0000 CODE SEGMENT WORD PUBLIC 'CODE' + 218 + 219 ASSUME CS:CODE, DS:DC, ES:DC + 220 + 221 + 222 ; Run-time entries + 223 + 224 PUBLIC $BLALC,$BLDEA + 225 PUBLIC $FBLOC,$FBALC,$FBDEA + 226 + 227 + 228 ; Run-time externals + 229 + 230 EXTRN $$RSS:NEAR + 231 + 232 EXTRN $ERC_IOE:NEAR + 233 + 234 + 235 0000 Locals PROC NEAR + 236 + 237 ;** $FBLOC - Locate file block for file number + 238 ; + 239 ; ENTRY (BX) = file number + 240 ; EXIT (SI) = File Data Block address + 241 ; 'Z' set if not present + 242 + 243 0000 $FBLOC: + 244 0000 0A FF OR BH,BH + 245 0002 75 17 JNZ lfbzro ;Error - illegal file number + 246 + 247 0004 BE 0002 E MOV SI,OFFSET DC:$FILPT-BL_LNK ;(SI) = address of file list pointer + 248 + 249 0007 8B 74 FE lfb1: MOV SI,[SI].BL_LNK ;Address of next file + 250 000A 0B F6 OR SI,SI + 251 000C 74 0F JZ lfbret ;No more files - not open + 252 + 253 000E 38 5C FB CMP [SI].FB_NUM,BL ;Compare file numbers + 254 0011 75 F4 JNZ lfb1 ;Not equal - try next one + 255 + 256 0013 80 3C 00 CMP [SI].FD_MODE,0 ;Test if open + 257 0016 75 05 JNZ lfbret ; Yes + 258 + 259 0018 E8 0061 R CALL $FBDEA ;Deallocate block + 260 + 261 001B 33 F6 lfbzro: XOR SI,SI ;Set 'Z' + 262 + 263 001D C3 lfbret: RET ; Must be non-zero + 264 + 265 + 266 + 267 + 268 ;** $FBALC/$BLALC - Allocate file block + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 2-2 + + + + 269 ; + 270 ; ENTRY (BX) = desired block size (not including link area) + 271 ; EXIT (SI) = file data block address + 272 ; Block is zeroed but not linked + 273 + 274 001E $BLALC: + 275 001E $FBALC: + 276 001E 50 PUSH AX + 277 001F 51 PUSH CX + 278 0020 52 PUSH DX + 279 0021 57 PUSH DI + 280 0022 53 PUSH BX + 281 0023 BE 0002 E MOV SI,OFFSET DC:$FREPT-BL_LNK ;(SI) = address of free block chain + 282 + 283 0026 8B FE afb1: MOV DI,SI ;Save previous link pointer + 284 0028 8B 74 FE MOV SI,[SI].BL_LNK ;(SI) = address of next free block + 285 002B 0B F6 OR SI,SI + 286 002D 74 10 JZ afb2 ;No more free entries - allocate new + 287 + 288 002F 39 5C FC CMP [SI].BL_LEN,BX ;Check length + 289 0032 72 F2 JB afb1 ; Not large enough + 290 + 291 ; We found a large enough one + 292 + 293 0034 8B 44 FE MOV AX,[SI].BL_LNK ;Unlink (SI) block + 294 0037 89 45 FE MOV [DI].BL_LNK,AX + 295 003A 8B 4C FC MOV CX,[SI].BL_LEN ;(CX) = length + 296 003D EB 0E JMP SHORT afb3 ;Go to common code + 297 + 298 ; We must allocate a new buffer + 299 + 300 003F 8B CB afb2: MOV CX,BX ;Save length + 301 0041 83 C3 06 ADD BX,-BL_SIZE ;Adjust for link block + 302 0044 E8 0000 E CALL $$RSS ;Rob some string space + 303 0047 8D 77 06 LEA SI,[BX-BL_SIZE] ;Adjust for link block + 304 004A 89 4C FC MOV [SI].BL_LEN,CX ;Set length of block + 305 + 306 004D 8B FE afb3: MOV DI,SI ;(DI) = block address + 307 004F 33 C0 XOR AX,AX ;(AX) = 0 + 308 0051 D1 E9 SHR CX,1 ;Zero (CX) bytes + 309 0053 F3/ AB REP STOSW + 310 0055 73 01 JNC afb4 + 311 0057 AA STOSB + 312 0058 5B afb4: POP BX + 313 0059 5F POP DI + 314 005A 5A POP DX + 315 005B 59 POP CX + 316 005C 58 POP AX + 317 005D C3 RET + 318 + 319 + 320 + 321 ;** $BLDEA - Deallocate block + 322 ; + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Page 2-3 + + + + 323 ; Entry (SI) = block address to release + 324 ; USES NONE + 325 + 326 005E 57 $BLDEA: PUSH DI + 327 005F EB 19 JMP SHORT dfb2 + 328 + 329 + 330 + 331 ;** $FBDEA - Deallocate file block + 332 ; + 333 ; ENTRY (SI) = block address to release + 334 ; USES NONE + 335 + 336 0061 $FBDEA: + 337 0061 57 PUSH DI + 338 0062 53 PUSH BX + 339 0063 BF 0002 E MOV DI,OFFSET DC:$FILPT-BL_LNK ;(DI) = start of file list + 340 + 341 0066 8B DF dfb1: MOV BX,DI ;Save previous block + 342 0068 8B 7D FE MOV DI,[DI].BL_LNK ;(DI) = next entry + 343 006B 0B FF OR DI,DI + 344 006D 74 18 JZ ercioe ;Not there !!! + 345 006F 3B FE CMP DI,SI + 346 0071 75 F3 JNE dfb1 ; Try the next one + 347 + 348 ; Found the block - unlink it from file list and add to free list + 349 + 350 0073 8B 7C FE MOV DI,[SI].BL_LNK ;Unlink (SI) block + 351 0076 89 7F FE MOV [BX].BL_LNK,DI + 352 0079 5B POP BX + 353 + 354 007A 8B 3E 0000 E dfb2: MOV DI,[$FREPT] ;Add to front of free list + 355 007E 89 36 0000 E MOV [$FREPT],SI + 356 0082 89 7C FE MOV [SI].BL_LNK,DI ;Link to previous head + 357 0085 5F POP DI + 358 0086 C3 RET + 359 + 360 0087 E9 0000 E ercioe: JMP $ERC_IOE ;I/O error (any would do) + 361 + 362 + 363 008A Locals ENDP + 364 + 365 008A CODE ENDS + 366 + 367 END + + + + + + + + + + + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 008A WORD PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +AFB1 . . . . . . . . . . . . . . L NEAR 0026 CODE +AFB2 . . . . . . . . . . . . . . L NEAR 003F CODE +AFB3 . . . . . . . . . . . . . . L NEAR 004D CODE +AFB4 . . . . . . . . . . . . . . L NEAR 0058 CODE +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +DFB1 . . . . . . . . . . . . . . L NEAR 0066 CODE + +IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:17 13-Nov-81 Symbols-2 + + + +DFB2 . . . . . . . . . . . . . . L NEAR 007A CODE +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +EOFCHR . . . . . . . . . . . . . Number 001A +ERCIOE . . . . . . . . . . . . . L NEAR 0087 CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LFB1 . . . . . . . . . . . . . . L NEAR 0007 CODE +LFBRET . . . . . . . . . . . . . L NEAR 001D CODE +LFBZRO . . . . . . . . . . . . . L NEAR 001B CODE +LOCALS . . . . . . . . . . . . . N PROC 0000 CODE Length =008A +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +REC_LENGTH . . . . . . . . . . . Number 0080 +$$RSS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$BLALC . . . . . . . . . . . . . L NEAR 001E CODE Global +$BLDEA . . . . . . . . . . . . . L NEAR 005E CODE Global +$ERC_IOE . . . . . . . . . . . . L NEAR 0000 CODE External +$FBALC . . . . . . . . . . . . . L NEAR 001E CODE Global +$FBDEA . . . . . . . . . . . . . L NEAR 0061 CODE Global +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FILPT . . . . . . . . . . . . . V WORD 0000 DATA External +$FREPT . . . . . . . . . . . . . V WORD 0000 DATA External +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 diff --git a/3_source_code/BASLIB-86/IOFILM.ASM b/3_source_code/BASLIB-86/IOFILM.ASM new file mode 100644 index 0000000..6e5ffeb --- /dev/null +++ b/3_source_code/BASLIB-86/IOFILM.ASM @@ -0,0 +1,172 @@ + TITLE IOFILM - File Manager for BASCOM-86 +PAGE 60,132 +; This module contains the dynamic file management routines for the +; 8086 BASIC Compiler runtime. + + INCLUDE TABMAC.INC + + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FILPT:WORD ;File block list head + EXTRN $FREPT:WORD ;File block list head + + INCLUDE DEVDEF.INC + +DATA ENDS + +DC GROUP DATA + + + +CODE SEGMENT WORD PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + + +; Run-time entries + + PUBLIC $BLALC,$BLDEA + PUBLIC $FBLOC,$FBALC,$FBDEA + + +; Run-time externals + + EXTRN $$RSS:NEAR + + EXTRN $ERC_IOE:NEAR + + +Locals PROC NEAR + +;** $FBLOC - Locate file block for file number +; +; ENTRY (BX) = file number +; EXIT (SI) = File Data Block address +; 'Z' set if not present + +$FBLOC: + OR BH,BH + JNZ lfbzro ;Error - illegal file number + + MOV SI,OFFSET DC:$FILPT-BL_LNK ;(SI) = address of file list pointer + +lfb1: MOV SI,[SI].BL_LNK ;Address of next file + OR SI,SI + JZ lfbret ;No more files - not open + + CMP [SI].FB_NUM,BL ;Compare file numbers + JNZ lfb1 ;Not equal - try next one + + CMP [SI].FD_MODE,0 ;Test if open + JNZ lfbret ; Yes + + CALL $FBDEA ;Deallocate block + +lfbzro: XOR SI,SI ;Set 'Z' + +lfbret: RET ; Must be non-zero + + + + +;** $FBALC/$BLALC - Allocate file block +; +; ENTRY (BX) = desired block size (not including link area) +; EXIT (SI) = file data block address +; Block is zeroed but not linked + +$BLALC: +$FBALC: + PUSH AX + PUSH CX + PUSH DX + PUSH DI + PUSH BX + MOV SI,OFFSET DC:$FREPT-BL_LNK ;(SI) = address of free block chain + +afb1: MOV DI,SI ;Save previous link pointer + MOV SI,[SI].BL_LNK ;(SI) = address of next free block + OR SI,SI + JZ afb2 ;No more free entries - allocate new + + CMP [SI].BL_LEN,BX ;Check length + JB afb1 ; Not large enough + +; We found a large enough one + + MOV AX,[SI].BL_LNK ;Unlink (SI) block + MOV [DI].BL_LNK,AX + MOV CX,[SI].BL_LEN ;(CX) = length + JMP SHORT afb3 ;Go to common code + +; We must allocate a new buffer + +afb2: MOV CX,BX ;Save length + ADD BX,-BL_SIZE ;Adjust for link block + CALL $$RSS ;Rob some string space + LEA SI,[BX-BL_SIZE] ;Adjust for link block + MOV [SI].BL_LEN,CX ;Set length of block + +afb3: MOV DI,SI ;(DI) = block address + XOR AX,AX ;(AX) = 0 + SHR CX,1 ;Zero (CX) bytes + REP STOSW + JNC afb4 + STOSB +afb4: POP BX + POP DI + POP DX + POP CX + POP AX + RET + + + +;** $BLDEA - Deallocate block +; +; Entry (SI) = block address to release +; USES NONE + +$BLDEA: PUSH DI + JMP SHORT dfb2 + + + +;** $FBDEA - Deallocate file block +; +; ENTRY (SI) = block address to release +; USES NONE + +$FBDEA: + PUSH DI + PUSH BX + MOV DI,OFFSET DC:$FILPT-BL_LNK ;(DI) = start of file list + +dfb1: MOV BX,DI ;Save previous block + MOV DI,[DI].BL_LNK ;(DI) = next entry + OR DI,DI + JZ ercioe ;Not there !!! + CMP DI,SI + JNE dfb1 ; Try the next one + +; Found the block - unlink it from file list and add to free list + + MOV DI,[SI].BL_LNK ;Unlink (SI) block + MOV [BX].BL_LNK,DI + POP BX + +dfb2: MOV DI,[$FREPT] ;Add to front of free list + MOV [$FREPT],SI + MOV [SI].BL_LNK,DI ;Link to previous head + POP DI + RET + +ercioe: JMP $ERC_IOE ;I/O error (any would do) + + +Locals ENDP + +CODE ENDS + + END From c97d069171df910c85a55977526592770b11fd1a Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 16 Jul 2026 19:03:04 -0700 Subject: [PATCH 37/53] Transcription of Bundle 9 - IOLPT.ASM Code and Listing --- 2_printed_files/bundle_09/IOLPT.ASM | 1021 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/IOLPT.ASM | 283 ++++++++ 2 files changed, 1304 insertions(+) create mode 100644 2_printed_files/bundle_09/IOLPT.ASM create mode 100644 3_source_code/BASLIB-86/IOLPT.ASM diff --git a/2_printed_files/bundle_09/IOLPT.ASM b/2_printed_files/bundle_09/IOLPT.ASM new file mode 100644 index 0000000..311a674 --- /dev/null +++ b/2_printed_files/bundle_09/IOLPT.ASM @@ -0,0 +1,1021 @@ +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-1 + + + + 1 TITLE IOLPT - Line printer Device Drivers + 2 SUBTTL Support for 1 line printers + 3 + 4 + 5 ; This module contains the device independent printer routines for + 6 ; the BASIC Compiler. While this module is intended for use with + 7 ; the IBM Personal Computer, there is only a small amount which + 8 ; actually depends on this fact. + 9 + 10 ; Modified for 1 printer systems (subset of IBM) + 11 + 12 + 13 = 0084 iniwid= 132 ;Initial printer width + 14 + 15 = 000A LF= 10 + 16 = 000D CR= 13 + 17 + 18 + 19 C INCLUDE TABMAC.INC + 20 C ; Special Table Generation Macros + 21 C + 22 C ENTORG MACRO First_entry + 23 C .XCREF + 24 C ___ZZZ= First_entry + 25 C .CREF + 26 C ENDM + 27 C + 28 C + 29 C ENT MACRO Lab,Incr + 30 C Lab= ___ZZZ + 31 C .XCREF + 32 C ___ZZZ= ___ZZZ+Incr + 33 C .CREF + 34 C ENDM + 35 C + 36 C + 37 C ENTI MACRO Incr + 38 C .XCREF + 39 C ___ZZZ= ___ZZZ+Incr + 40 C .CREF + 41 C ENDM + 42 C + 43 + 44 C INCLUDE DEVDEF.INC + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-2 +Support for 1 line printers + + + 45 C PAGE + 46 C + 47 C ; DEVDEF.INC - Device Independent I/O Definitions + 48 C + 49 C INCLUDE SYSTEM.INC + 50 C ; Operating System Selection + 51 C + 52 = 0000 C _IBM_= 0 + 53 C + 54 = 0001 C _MSDOS_= 1 + 55 = 0000 C _CPM_= 0 + 56 C + 57 C ; Overrides + 58 C + 59 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ + 60 C + 61 C if1 + 62 C if _CPM_ + 63 C %OUT ! CP/M-86 Version + 64 C endif + 65 C if _MSDOS_ + 66 C %OUT ! MSDOS Version + 67 C endif + 68 C if _IBM_ + 69 C %OUT ! IBM Personal Computer + 70 C endif + 71 C + 72 C if _MSDOS_+_CPM_ ne 1 + 73 C %OUT ##################### Error - Bad Operating System Selection + 74 C + 75 C error + 76 C endif + 77 C endif + 78 C + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-3 +Support for 1 line printers + + + 79 C PAGE + 80 C + 81 C DEVNAM MACRO + 82 C DEVMAC KYBD + 83 C DEVMAC SCRN + 84 C if _IBM_ + 85 C DEVMAC CAS1 + 86 C DEVMAC COM1 + 87 C DEVMAC COM2 + 88 C endif + 89 C DEVMAC LPT1 + 90 C if _IBM_ + 91 C DEVMAC LPT2 + 92 C DEVMAC LPT3 + 93 C endif + 94 C ENDM + 95 C + 96 = FFFF C ___DEV= -1 + 97 C + 98 C DEVMAC MACRO ARG + 99 C DN_&ARG= ___DEV + 100 C .xcref + 101 C ___DEV= ___DEV-1 + 102 C .cref + 103 C ENDM + 104 C + 105 C DEVNAM + 106 C + 107 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-4 +Support for 1 line printers + + + 108 C PAGE + 109 C + 110 C DSPNAM MACRO + 111 C DSPMAC EOF ;EOF function + 112 C DSPMAC LOC ;LOC function + 113 C DSPMAC LOF ;LOF function + 114 C ; DSPMAC POS ;POS function + 115 C DSPMAC CLOSE ;CLOSE statement + 116 C DSPMAC WIDTH ;WIDTH statement + 117 C DSPMAC RANDIO ;GET/PUT statements + 118 C DSPMAC OPEN ;OPEN statement + 119 C DSPMAC BAKC ;Backup character + 120 C DSPMAC SINP ;Serial input + 121 C DSPMAC SOUT ;Serial output + 122 C DSPMAC GPOS ;Get current position + 123 C DSPMAC GWID ;Get current width + 124 C ENDM + 125 C + 126 C + 127 C ; Device Function Dispatch Table Offsets + 128 C + 129 C + 130 C DSPMAC MACRO func + 131 C ENT DV_&func,2 + 132 C ENDM + 133 C + 134 C + 135 C ENTORG 0 + 136 C DSPNAM + 137 C ENT DV_TABLEN,0 + 138 C + + + + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-5 +Support for 1 line printers + + + 139 C PAGE + 140 C + 141 C ; File Mode Definitions + 142 C + 143 = 0001 C MD_SQI EQU 1 + 144 = 0002 C MD_SQO EQU 2 + 145 = 0004 C MD_RND EQU 4 + 146 = 0004 C MD_FIL EQU 4 + 147 = 0008 C MD_APP EQU 8 + 148 = 0010 C MD_KIL EQU 16 + 149 = 0020 C MD_IBM EQU 32 + 150 = 0040 C MD_USR EQU 64 + 151 = 0080 C MD_BIN EQU 128 + 152 C + 153 C + 154 C ; Operating System dependent field sizes + 155 C + 156 = 001A C EOFCHR= 'Z' and 1fh + 157 C + 158 = 0026 C FILNAML= 38 ;Length of $FILNAM + 159 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) + 160 C + 161 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs + 162 = 0080 C REC_LENGTH= 128 ;128 byte sectors + 163 C + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-6 +Support for 1 line printers + + + 164 C PAGE + 165 C + 166 C ;----- Basic Interpreter style File Data Block ----- + 167 C + 168 C ; Link block offsets + 169 C + 170 =-0006 C BL_SIZE= -6 ;Link block size (2 bytes of misc) + 171 =-0005 C FB_NUM= -5 ; File number + 172 =-0004 C BL_LEN= -4 ;Block size + 173 =-0002 C BL_LNK= -2 ;Block link + 174 C + 175 C ; File Data Block offsets + 176 C + 177 C FILE_DATA_BLOCK STRUC + 178 C + 179 0000 ?? C FD_MODE DB ? ;File mode of open + 180 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area + 181 ?? C + 182 ] C + 183 C + 184 0027 ???? C FD_CURLOC DW ? ;Current record number + 185 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector + 186 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer + 187 002B 03 [ C DB 3 DUP (?) ;Unused + 188 ?? C + 189 ] C + 190 C + 191 002E ?? C FD_DEVICE DB ? ;Device number + 192 002F ?? C FD_WIDTH DB ? ;File width + 193 0030 ?? C FD_POS DB ? ;Current file position + 194 0031 ?? C FD_FLAGS DB ? ;Used for load and save + 195 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion + 196 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer + 197 ?? C + 198 ] C + 199 C + 200 C + 201 C ; 5.0 Variable Record Information + 202 C + 203 00B3 ???? C FR_VRECL DW ? ;Variable record length + 204 00B5 ???? C FR_PHYREC DW ? ;Current physical record number + 205 00B7 ???? C FR_LOGREC DW ? ;Current logical record number + 206 00B9 ?? C DB ? ;Future use + 207 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O + 208 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer + 209 ?? C + 210 ] C + 211 C + 212 C + 213 00BD C FILE_DATA_BLOCK ENDS + 214 C + 215 C + 216 C ; End of DEVDEF.INC + 217 + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 1-7 +Support for 1 line printers + + + 218 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 219 + 220 EXTRN $FILMOD:BYTE + 221 + 222 0000 DATA ENDS + 223 + 224 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 225 + 226 PUBLIC $LPTFDB + 227 + 228 0000 84 LPTWID DB iniwid ;width/initial position + 229 0001 00 LPTPOS DB 0 + 230 + 231 0002 33 [ $LPTFDB DB FD_BUFFER DUP (0) ;LPRINT file data block + 232 00 + 233 ] + 234 + 235 + 236 0035 CONST ENDS + 237 + 238 DC GROUP CONST,DATA + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 2-1 +Support for 1 line printers + + + 239 + 240 + 241 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 242 + 243 ASSUME CS:CODE, DS:DC, ES:DC + 244 + 245 + 246 ; Run-time Entries + 247 + 248 PUBLIC $D_LPT1,$I_LPT1,$W_LPT1,$C_LPT1 + 249 + 250 PUBLIC $LPO,$LWI + 251 + 252 + 253 ; Run-time Externals + 254 + 255 EXTRN $LPTOT:NEAR + 256 EXTRN $$WCLF:NEAR + 257 EXTRN $DEVOPN:NEAR,$FRCSQO:NEAR,$FBDEA:NEAR + 258 EXTRN $ERC_FC:NEAR + 259 + 260 + 261 ; Illegal Device Functions + 262 + 263 = LPT_EOF EQU $ERC_FC + 264 = LPT_LOC EQU $ERC_FC + 265 = LPT_LOF EQU $ERC_FC + 266 = LPT_RANDIO EQU $ERC_FC + 267 = LPT_BAKC EQU $ERC_FC + 268 = LPT_SINP EQU $ERC_FC + 269 + 270 + 271 ; Device Independent Printer Interface + 272 + 273 DSPMAC MACRO func + 274 DW LPT_&func + 275 ENDM + 276 + 277 0000 $D_LPT1: + 278 DSPNAM + 279 0000 0000 E + DW LPT_EOF + 280 0002 0000 E + DW LPT_LOC + 281 0004 0000 E + DW LPT_LOF + 282 0006 0092 R + DW LPT_CLOSE + 283 0008 005D R + DW LPT_WIDTH + 284 000A 0000 E + DW LPT_RANDIO + 285 000C 0043 R + DW LPT_OPEN + 286 000E 0000 E + DW LPT_BAKC + 287 0010 0000 E + DW LPT_SINP + 288 0012 0061 R + DW LPT_SOUT + 289 0014 0089 R + DW LPT_GPOS + 290 0016 008E R + DW LPT_GWID + 291 + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 3-1 +Support for 1 line printers + + + 292 + 293 + 294 ;----- Device Action Routines ---------------------------------------------- + 295 + 296 + 297 ; These routines are always called from special device dispatchers. + 298 ; + 299 ; The registers are set up as follows: + 300 ; + 301 ; (DI) = device offset + 302 ; + 303 ; The remaining registers are used to pass parameters. + 304 + 305 + 306 0018 devio PROC NEAR + 307 + 308 ; Device initialization routines + 309 ; + 310 ; ENTRY (DI) = Device offset + 311 ; USES any but DI + 312 + 313 0018 $I_LPT1: + 314 0018 C6 06 0002 R 02 MOV $LPTFDB.FD_MODE,MD_SQO ;Initialize LPRINT file data block + 315 001D C6 06 0030 R FD MOV $LPTFDB.FD_DEVICE,DN_LPT1 + 316 0022 C6 06 0031 R 84 MOV $LPTFDB.FD_WIDTH,iniwid + 317 0027 C3 RET + 318 + 319 + 320 ; Device close routines + 321 ; + 322 ; ENTRY (DI) = Device offset + 323 ; USES any but DI + 324 + 325 0028 $C_LPT1: + 326 0028 80 3E 0001 R 00 CMP LPTPOS,0 + 327 002D 74 0A JE cret + 328 002F B0 0D MOV AL,CR + 329 0031 E8 0000 E CALL $LPTOT + 330 0034 B0 0A MOV AL,LF + 331 0036 E8 0000 E CALL $LPTOT + 332 + 333 0039 C3 cret: RET + 334 + 335 + 336 ; Device width routines + 337 ; + 338 ; ENTRY (DL) = device width + 339 ; (DI) = Device offset + 340 ; USES none + 341 + 342 003A $W_LPT1: + 343 003A 88 16 0031 R MOV $LPTFDB.FD_WIDTH,DL ;Set LPRINT file width + 344 003E 88 16 0000 R MOV LPTWID,DL ;Set new printer width + 345 0042 C3 RET + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 3-2 +Support for 1 line printers + + + 346 + 347 0043 devio ENDP + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 4-1 +Support for 1 line printers + + + 348 + 349 + 350 ;----- File Action Routines ----------------------------------------------- + 351 + 352 + 353 ; These routines are all called from the file dispatcher. + 354 ; + 355 ; The registers are set up as follows: + 356 ; + 357 ; (SI) = file data block address (points to file mode field) + 358 ; (DI) = device offset (0 = disk , 2 = next , 4 = next , ...) + 359 ; (AH) = function code of routine + 360 ; (AL,CX,DX,BX) = parameters for each routine + 361 ; + 362 ; These routines are free to use SI and DI as temporaries + 363 + 364 + 365 0043 fileio PROC + 366 + 367 ; OPEN statement + 368 ; + 369 ; ENTRY (BX) = file number + 370 ; (AL) = device number for OPEN + 371 ; (DX) = file name descriptor (not used here) + 372 ; (CX) = variable record length (not used here) + 373 + 374 0043 LPT_OPEN: + 375 0043 E8 0000 E CALL $FRCSQO ;Change MD_RND to MD_SQO + 376 0046 51 PUSH CX + 377 0047 52 PUSH DX + 378 0048 53 PUSH BX + 379 0049 33 C9 XOR CX,CX ;(CX) = extra FDB size + 380 004B 8B 16 0000 R MOV DX,WORD PTR LPTWID ;(DH,DL) = (position,width) + 381 004F B4 02 MOV AH,MD_SQO ;Valid file modes + 382 0051 E8 0000 E CALL $DEVOPN ;Open file data block + 383 0054 A0 0000 E MOV AL,[$FILMOD] + 384 0057 88 04 MOV [SI].FD_MODE,AL ;Set file mode + 385 0059 5B POP BX + 386 005A 5A POP DX + 387 005B 59 POP CX + 388 005C C3 RET + 389 + 390 + 391 ; WIDTH file statement + 392 ; + 393 ; ENTRY (BX) = file number + 394 ; (DL) = file width + 395 + 396 005D LPT_WIDTH: + 397 005D 88 54 2F MOV [SI].FD_WIDTH,DL + 398 0060 C3 RET + 399 + 400 + 401 ; SOUT - Serial character output + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 4-2 +Support for 1 line printers + + + 402 ; + 403 ; ENTRY (AL) = character + 404 ; USES AX,SI,DI + 405 + 406 0061 LPT_SOUT: + 407 0061 50 PUSH AX ;(AL) = character + 408 0062 E8 0000 E CALL $LPTOT ;Print character (DI) = device offset + 409 0065 58 POP AX + 410 0066 3C 0D CMP AL,CR ;Is CR? + 411 0068 74 19 JE sout1 ; Yes + 412 006A 3C 20 CMP AL,' ' ;Is printing char? + 413 006C 72 1A JB sout2 ; No + 414 + 415 006E FE 06 0001 R INC LPTPOS ;Bump position (device) + 416 0072 8A 64 2F MOV AH,[SI].FD_WIDTH ;Get printer (file) width + 417 0075 80 FC FF CMP AH,255 + 418 0078 74 0E JE sout2 ;Infinite width + 419 + 420 007A 3A 26 0001 R CMP AH,LPTPOS ;At end of line + 421 007E 77 08 JA sout2 + 422 + 423 0080 E8 0000 E CALL $$WCLF ;Write CR/LF to printer + 424 + 425 0083 C6 06 0001 R 00 sout1: MOV LPTPOS,0 ;Set position (device) to 0 + 426 + 427 0088 C3 sout2: RET + 428 + 429 + 430 ; GPOS - Get position + 431 ; + 432 ; EXIT (AH) = device position + 433 + 434 0089 LPT_GPOS: + 435 0089 8A 26 0001 R MOV AH,LPTPOS ;Get position (device) + 436 008D C3 RET + 437 + 438 + 439 ; GWID - Get width + 440 ; + 441 ; EXIT (AH) = file width + 442 + 443 008E LPT_GWID: + 444 008E 8A 64 2F MOV AH,[SI].FD_WIDTH ;Get printer (file) width + 445 0091 C3 RET + 446 + 447 + 448 ; CLOSE - Line printer file close + 449 ; + 450 ; Deallocate file block + 451 + 452 0092 LPT_CLOSE: + 453 0092 E8 0000 E CALL $FBDEA ;Deallocate buffer + 454 0095 C3 RET + 455 + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 4-3 +Support for 1 line printers + + + 456 + 457 0096 fileio ENDP + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Page 5-1 +Support for 1 line printers + + + 458 + 459 + 460 0096 Entries PROC FAR + 461 + 462 + 463 + 464 ;** $LPO - Line printer position + 465 ; + 466 ; Get line printer position + 467 ; + 468 ; ENTRY NONE + 469 ; EXIT (BX) = printer position + 470 + 471 0096 $LPO: + 472 0096 8A 1E 0001 R MOV BL,LPTPOS ;Get position for printer + 473 009A B7 00 MOV BH,0 + 474 009C 43 INC BX + 475 009D CB RET + 476 + 477 + 478 + 479 ; WIDTH LPRINT Statement + 480 ; + 481 ; Sets the LPRINT file width and device width + 482 + 483 009E $LWI: + 484 009E 88 1E 0031 R MOV $LPTFDB.FD_WIDTH,BL ;Set LPRINT file width + 485 00A2 88 1E 0000 R MOV LPTWID,BL ;Set printer 1 width + 486 00A6 CB RET + 487 + 488 + 489 00A7 Entries ENDP + 490 + 491 00A7 CODE ENDS + 492 + 493 END + + + + + + + + + + + + + + + + + + + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00A7 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0035 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +CR . . . . . . . . . . . . . . . Number 000D +CRET . . . . . . . . . . . . . . L NEAR 0039 CODE +DEVIO. . . . . . . . . . . . . . N PROC 0018 CODE Length =002B +DN_KYBD. . . . . . . . . . . . . Number FFFF + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Symbols-2 + + + +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +ENTRIES. . . . . . . . . . . . . F PROC 0096 CODE Length =0011 +EOFCHR . . . . . . . . . . . . . Number 001A +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILEIO . . . . . . . . . . . . . N PROC 0043 CODE Length =0053 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +INIWID . . . . . . . . . . . . . Number 0084 +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LF . . . . . . . . . . . . . . . Number 000A +LPTPOS . . . . . . . . . . . . . L BYTE 0001 CONST +LPTWID . . . . . . . . . . . . . L BYTE 0000 CONST +LPT_BAKC . . . . . . . . . . . . Alias $ERC_FC +LPT_CLOSE. . . . . . . . . . . . L NEAR 0092 CODE +LPT_EOF. . . . . . . . . . . . . Alias $ERC_FC +LPT_GPOS . . . . . . . . . . . . L NEAR 0089 CODE +LPT_GWID . . . . . . . . . . . . L NEAR 008E CODE +LPT_LOC. . . . . . . . . . . . . Alias $ERC_FC +LPT_LOF. . . . . . . . . . . . . Alias $ERC_FC +LPT_OPEN . . . . . . . . . . . . L NEAR 0043 CODE +LPT_RANDIO . . . . . . . . . . . Alias $ERC_FC +LPT_SINP . . . . . . . . . . . . Alias $ERC_FC +LPT_SOUT . . . . . . . . . . . . L NEAR 0061 CODE +LPT_WIDTH. . . . . . . . . . . . L NEAR 005D CODE +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +REC_LENGTH . . . . . . . . . . . Number 0080 +SOUT1. . . . . . . . . . . . . . L NEAR 0083 CODE +SOUT2. . . . . . . . . . . . . . L NEAR 0088 CODE +$$WCLF . . . . . . . . . . . . . L NEAR 0000 CODE External +$C_LPT1. . . . . . . . . . . . . L NEAR 0028 CODE Global +$DEVOPN. . . . . . . . . . . . . L NEAR 0000 CODE External + + +IOLPT - Line printer Device Drivers Macro-86 %1(12) 1:5:30 13-Nov-81 Symbols-3 + + + +$D_LPT1. . . . . . . . . . . . . L NEAR 0000 CODE Global +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$FBDEA . . . . . . . . . . . . . L NEAR 0000 CODE External +$FILMOD. . . . . . . . . . . . . V BYTE 0000 DATA External +$FRCSQO. . . . . . . . . . . . . L NEAR 0000 CODE External +$I_LPT1. . . . . . . . . . . . . L NEAR 0018 CODE Global +$LPO . . . . . . . . . . . . . . L NEAR 0096 CODE Global +$LPTFDB. . . . . . . . . . . . . L BYTE 0002 CONST Global Length =0033 +$LPTOT . . . . . . . . . . . . . L NEAR 0000 CODE External +$LWI . . . . . . . . . . . . . . L NEAR 009E CODE Global +$W_LPT1. . . . . . . . . . . . . L NEAR 003A CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/IOLPT.ASM b/3_source_code/BASLIB-86/IOLPT.ASM new file mode 100644 index 0000000..308e085 --- /dev/null +++ b/3_source_code/BASLIB-86/IOLPT.ASM @@ -0,0 +1,283 @@ + TITLE IOLPT - Line printer Device Drivers + SUBTTL Support for 1 line printers +PAGE 60,132 + +; This module contains the device independent printer routines for +; the BASIC Compiler. While this module is intended for use with +; the IBM Personal Computer, there is only a small amount which +; actually depends on this fact. + +; Modified for 1 printer systems (subset of IBM) + + +iniwid= 132 ;Initial printer width + +LF= 10 +CR= 13 + + + INCLUDE TABMAC.INC + + INCLUDE DEVDEF.INC + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FILMOD:BYTE + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + PUBLIC $LPTFDB + +LPTWID DB iniwid ;width/initial position +LPTPOS DB 0 + +$LPTFDB DB FD_BUFFER DUP (0) ;LPRINT file data block + +CONST ENDS + +DC GROUP CONST,DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + + +; Run-time Entries + + PUBLIC $D_LPT1,$I_LPT1,$W_LPT1,$C_LPT1 + + PUBLIC $LPO,$LWI + + +; Run-time Externals + + EXTRN $LPTOT:NEAR + EXTRN $$WCLF:NEAR + EXTRN $DEVOPN:NEAR,$FRCSQO:NEAR,$FBDEA:NEAR + EXTRN $ERC_FC:NEAR + + +; Illegal Device Functions + +LPT_EOF EQU $ERC_FC +LPT_LOC EQU $ERC_FC +LPT_LOF EQU $ERC_FC +LPT_RANDIO EQU $ERC_FC +LPT_BAKC EQU $ERC_FC +LPT_SINP EQU $ERC_FC + + +; Device Independent Printer Interface + +DSPMAC MACRO func + DW LPT_&func + ENDM + +$D_LPT1: + DSPNAM + + + +;----- Device Action Routines ---------------------------------------------- + + +; These routines are always called from special device dispatchers. +; +; The registers are set up as follows: +; +; (DI) = device offset +; +; The remaining registers are used to pass parameters. + + +devio PROC NEAR + +; Device initialization routines +; +; ENTRY (DI) = Device offset +; USES any but DI + +$I_LPT1: + MOV $LPTFDB.FD_MODE,MD_SQO ;Initialize LPRINT file data block + MOV $LPTFDB.FD_DEVICE,DN_LPT1 + MOV $LPTFDB.FD_WIDTH,iniwid + RET + + +; Device close routines +; +; ENTRY (DI) = Device offset +; USES any but DI + +$C_LPT1: + CMP LPTPOS,0 + JE cret + MOV AL,CR + CALL $LPTOT + MOV AL,LF + CALL $LPTOT + +cret: RET + + +; Device width routines +; +; ENTRY (DL) = device width +; (DI) = Device offset +; USES none + +$W_LPT1: + MOV $LPTFDB.FD_WIDTH,DL ;Set LPRINT file width + MOV LPTWID,DL ;Set new printer width + RET + +devio ENDP + + +;----- File Action Routines ----------------------------------------------- + + +; These routines are all called from the file dispatcher. +; +; The registers are set up as follows: +; +; (SI) = file data block address (points to file mode field) +; (DI) = device offset (0 = disk , 2 = next , 4 = next , ...) +; (AH) = function code of routine +; (AL,CX,DX,BX) = parameters for each routine +; +; These routines are free to use SI and DI as temporaries + + +fileio PROC + +; OPEN statement +; +; ENTRY (BX) = file number +; (AL) = device number for OPEN +; (DX) = file name descriptor (not used here) +; (CX) = variable record length (not used here) + +LPT_OPEN: + CALL $FRCSQO ;Change MD_RND to MD_SQO + PUSH CX + PUSH DX + PUSH BX + XOR CX,CX ;(CX) = extra FDB size + MOV DX,WORD PTR LPTWID ;(DH,DL) = (position,width) + MOV AH,MD_SQO ;Valid file modes + CALL $DEVOPN ;Open file data block + MOV AL,[$FILMOD] + MOV [SI].FD_MODE,AL ;Set file mode + POP BX + POP DX + POP CX + RET + + +; WIDTH file statement +; +; ENTRY (BX) = file number +; (DL) = file width + +LPT_WIDTH: + MOV [SI].FD_WIDTH,DL + RET + + +; SOUT - Serial character output +; +; ENTRY (AL) = character +; USES AX,SI,DI + +LPT_SOUT: + PUSH AX ;(AL) = character + CALL $LPTOT ;Print character (DI) = device offset + POP AX + CMP AL,CR ;Is CR? + JE sout1 ; Yes + CMP AL,' ' ;Is printing char? + JB sout2 ; No + + INC LPTPOS ;Bump position (device) + MOV AH,[SI].FD_WIDTH ;Get printer (file) width + CMP AH,255 + JE sout2 ;Infinite width + + CMP AH,LPTPOS ;At end of line + JA sout2 + + CALL $$WCLF ;Write CR/LF to printer + +sout1: MOV LPTPOS,0 ;Set position (device) to 0 + +sout2: RET + + +; GPOS - Get position +; +; EXIT (AH) = device position + +LPT_GPOS: + MOV AH,LPTPOS ;Get position (device) + RET + + +; GWID - Get width +; +; EXIT (AH) = file width + +LPT_GWID: + MOV AH,[SI].FD_WIDTH ;Get printer (file) width + RET + + +; CLOSE - Line printer file close +; +; Deallocate file block + +LPT_CLOSE: + CALL $FBDEA ;Deallocate buffer + RET + + +fileio ENDP + + +Entries PROC FAR + + + +;** $LPO - Line printer position +; +; Get line printer position +; +; ENTRY NONE +; EXIT (BX) = printer position + +$LPO: + MOV BL,LPTPOS ;Get position for printer + MOV BH,0 + INC BX + RET + + + +; WIDTH LPRINT Statement +; +; Sets the LPRINT file width and device width + +$LWI: + MOV $LPTFDB.FD_WIDTH,BL ;Set LPRINT file width + MOV LPTWID,BL ;Set printer 1 width + RET + + +Entries ENDP + +CODE ENDS + + END From a13f12ac5ee527e6c5f836a4bac918d484a79afa Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 17 Jul 2026 18:36:38 -0700 Subject: [PATCH 38/53] Transcription of Bundle 9 - IOTTY.ASM Code and Listing --- 2_printed_files/bundle_09/IOTTY.ASM | 1021 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/IOTTY.ASM | 270 +++++++ 2 files changed, 1291 insertions(+) create mode 100644 2_printed_files/bundle_09/IOTTY.ASM create mode 100644 3_source_code/BASLIB-86/IOTTY.ASM diff --git a/2_printed_files/bundle_09/IOTTY.ASM b/2_printed_files/bundle_09/IOTTY.ASM new file mode 100644 index 0000000..9f295b2 --- /dev/null +++ b/2_printed_files/bundle_09/IOTTY.ASM @@ -0,0 +1,1021 @@ +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-1 + + + + 1 TITLE IOTTY - Console driver for BASCOM-86 + 2 + 3 + 4 C INCLUDE TABMAC.INC + 5 C ; Special Table Generation Macros + 6 C + 7 C ENTORG MACRO First_entry + 8 C .XCREF + 9 C ___ZZZ= First_entry + 10 C .CREF + 11 C ENDM + 12 C + 13 C + 14 C ENT MACRO Lab,Incr + 15 C Lab= ___ZZZ + 16 C .XCREF + 17 C ___ZZZ= ___ZZZ+Incr + 18 C .CREF + 19 C ENDM + 20 C + 21 C + 22 C ENTI MACRO Incr + 23 C .XCREF + 24 C ___ZZZ= ___ZZZ+Incr + 25 C .CREF + 26 C ENDM + 27 C + 28 + 29 C INCLUDE DEVDEF.INC + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-2 + + + + 30 C PAGE + 31 C + 32 C ; DEVDEF.INC - Device Independent I/O Definitions + 33 C + 34 C INCLUDE SYSTEM.INC + 35 C ; Operating System Selection + 36 C + 37 = 0000 C _IBM_= 0 + 38 C + 39 = 0001 C _MSDOS_= 1 + 40 = 0000 C _CPM_= 0 + 41 C + 42 C ; Overrides + 43 C + 44 = 0001 C _MSDOS_= _MSDOS_ or _IBM_ + 45 C + 46 C if1 + 47 C if _CPM_ + 48 C %OUT ! CP/M-86 Version + 49 C endif + 50 C if _MSDOS_ + 51 C %OUT ! MSDOS Version + 52 C endif + 53 C if _IBM_ + 54 C %OUT ! IBM Personal Computer + 55 C endif + 56 C + 57 C if _MSDOS_+_CPM_ ne 1 + 58 C %OUT ##################### Error - Bad Operating System Selection + 59 C + 60 C error + 61 C endif + 62 C endif + 63 C + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-3 + + + + 64 C PAGE + 65 C + 66 C DEVNAM MACRO + 67 C DEVMAC KYBD + 68 C DEVMAC SCRN + 69 C if _IBM_ + 70 C DEVMAC CAS1 + 71 C DEVMAC COM1 + 72 C DEVMAC COM2 + 73 C endif + 74 C DEVMAC LPT1 + 75 C if _IBM_ + 76 C DEVMAC LPT2 + 77 C DEVMAC LPT3 + 78 C endif + 79 C ENDM + 80 C + 81 = FFFF C ___DEV= -1 + 82 C + 83 C DEVMAC MACRO ARG + 84 C DN_&ARG= ___DEV + 85 C .xcref + 86 C ___DEV= ___DEV-1 + 87 C .cref + 88 C ENDM + 89 C + 90 C DEVNAM + 91 C + 92 = 0008 C LAST_DEVICE_OFFSET= -2*___DEV ;All devices have lower offsets + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-4 + + + + 93 C PAGE + 94 C + 95 C DSPNAM MACRO + 96 C DSPMAC EOF ;EOF function + 97 C DSPMAC LOC ;LOC function + 98 C DSPMAC LOF ;LOF function + 99 C ; DSPMAC POS ;POS function + 100 C DSPMAC CLOSE ;CLOSE statement + 101 C DSPMAC WIDTH ;WIDTH statement + 102 C DSPMAC RANDIO ;GET/PUT statements + 103 C DSPMAC OPEN ;OPEN statement + 104 C DSPMAC BAKC ;Backup character + 105 C DSPMAC SINP ;Serial input + 106 C DSPMAC SOUT ;Serial output + 107 C DSPMAC GPOS ;Get current position + 108 C DSPMAC GWID ;Get current width + 109 C ENDM + 110 C + 111 C + 112 C ; Device Function Dispatch Table Offsets + 113 C + 114 C + 115 C DSPMAC MACRO func + 116 C ENT DV_&func,2 + 117 C ENDM + 118 C + 119 C + 120 C ENTORG 0 + 121 C DSPNAM + 122 C ENT DV_TABLEN,0 + 123 C + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-5 + + + + 124 C PAGE + 125 C + 126 C ; File Mode Definitions + 127 C + 128 = 0001 C MD_SQI EQU 1 + 129 = 0002 C MD_SQO EQU 2 + 130 = 0004 C MD_RND EQU 4 + 131 = 0004 C MD_FIL EQU 4 + 132 = 0008 C MD_APP EQU 8 + 133 = 0010 C MD_KIL EQU 16 + 134 = 0020 C MD_IBM EQU 32 + 135 = 0040 C MD_USR EQU 64 + 136 = 0080 C MD_BIN EQU 128 + 137 C + 138 C + 139 C ; Operating System dependent field sizes + 140 C + 141 = 001A C EOFCHR= 'Z' and 1fh + 142 C + 143 = 0026 C FILNAML= 38 ;Length of $FILNAM + 144 = 000B C FILNAM_LENGTH= 11 ;Actual length of name (8+3) + 145 C + 146 = 0026 C FCB_LENGTH= 38 ;38 byte FCBs + 147 = 0080 C REC_LENGTH= 128 ;128 byte sectors + 148 C + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-6 + + + + 149 C PAGE + 150 C + 151 C ;----- Basic Interpreter style File Data Block ----- + 152 C + 153 C ; Link block offsets + 154 C + 155 =-0006 C BL_SIZE= -6 ;Link block size (2 bytes of misc) + 156 =-0005 C FB_NUM= -5 ; File number + 157 =-0004 C BL_LEN= -4 ;Block size + 158 =-0002 C BL_LNK= -2 ;Block link + 159 C + 160 C ; File Data Block offsets + 161 C + 162 C FILE_DATA_BLOCK STRUC + 163 C + 164 0000 ?? C FD_MODE DB ? ;File mode of open + 165 0001 26 [ C FD_FCB DB FCB_LENGTH DUP (?) ;FCB area + 166 ?? C + 167 ] C + 168 C + 169 0027 ???? C FD_CURLOC DW ? ;Current record number + 170 0029 ?? C FD_ORNOFS DB ? ;Byte count in sector + 171 002A ?? C FD_NMLOFS DB ? ;Bytes left in input buffer + 172 002B 03 [ C DB 3 DUP (?) ;Unused + 173 ?? C + 174 ] C + 175 C + 176 002E ?? C FD_DEVICE DB ? ;Device number + 177 002F ?? C FD_WIDTH DB ? ;File width + 178 0030 ?? C FD_POS DB ? ;Current file position + 179 0031 ?? C FD_FLAGS DB ? ;Used for load and save + 180 0032 ?? C FD_OUTPOS DB ? ;Output position for tab expansion + 181 0033 80 [ C FD_BUFFER DB REC_LENGTH DUP (?) ;File record buffer + 182 ?? C + 183 ] C + 184 C + 185 C + 186 C ; 5.0 Variable Record Information + 187 C + 188 00B3 ???? C FR_VRECL DW ? ;Variable record length + 189 00B5 ???? C FR_PHYREC DW ? ;Current physical record number + 190 00B7 ???? C FR_LOGREC DW ? ;Current logical record number + 191 00B9 ?? C DB ? ;Future use + 192 00BA ???? C FR_OUTPOS DW ? ;Output position for sequential I/O + 193 00BC 01 [ C FR_FIELD DB 1 DUP (?) ;Field buffer + 194 ?? C + 195 ] C + 196 C + 197 C + 198 00BD C FILE_DATA_BLOCK ENDS + 199 C + 200 C + 201 C ; End of DEVDEF.INC + 202 + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 1-7 + + + + 203 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 204 + 205 EXTRN $FILMOD:BYTE + 206 + 207 0000 DATA ENDS + 208 + 209 + 210 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 211 + 212 EXTRN $TTYWID:BYTE + 213 + 214 0000 00 TTY_BAKCHR DB 0 + 215 0001 00 TTY_BAKFLG DB 0 ;Initially no character + 216 + 217 0002 CONST ENDS + 218 + 219 DC GROUP CONST,DATA + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-1 + + + + 220 + 221 + 222 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 223 + 224 ASSUME CS:CODE, DS:DC, ES:DC + 225 + 226 ; Run-time entries + 227 + 228 PUBLIC $WID,$POS + 229 PUBLIC $D_KYBD,$I_KYBD,$C_KYBD,$W_KYBD + 230 PUBLIC $D_SCRN,$I_SCRN,$C_SCRN,$W_SCRN + 231 PUBLIC $TTY_BAKC,$TTY_SINP,$TTY_SOUT,$TTY_GPOS,$TTY_GWID + 232 + 233 ; Run-time externals + 234 + 235 EXTRN $TTYIN:NEAR,$TTYOT:NEAR,$LTTYPS:NEAR,$STTYPS:NEAR + 236 EXTRN $$WCH:NEAR,$$WCLF:NEAR + 237 EXTRN $DEVOPN:NEAR,$FRCSQO:NEAR + 238 EXTRN $FBDEA:NEAR + 239 EXTRN $ERC_FC:NEAR + 240 IF _IBM_ + 241 EXTRN $SCNWID:NEAR + 242 ENDIF + 243 + 244 + 245 ; Illegal Device Functions + 246 + 247 = KYBD_EOF EQU $ERC_FC + 248 = KYBD_LOC EQU $ERC_FC + 249 = KYBD_LOF EQU $ERC_FC + 250 = KYBD_WIDTH EQU $ERC_FC + 251 = KYBD_RANDIO EQU $ERC_FC + 252 = KYBD_SOUT EQU $ERC_FC + 253 = KYBD_GPOS EQU $ERC_FC + 254 = KYBD_GWID EQU $ERC_FC + 255 + 256 = SCRN_EOF EQU $ERC_FC + 257 = SCRN_LOC EQU $ERC_FC + 258 = SCRN_LOF EQU $ERC_FC + 259 = SCRN_RANDIO EQU $ERC_FC + 260 = SCRN_BAKC EQU $ERC_FC + 261 = SCRN_SINP EQU $ERC_FC + 262 + 263 + 264 ; Devide Independent Console Interface + 265 + 266 DSPMAC MACRO func + 267 DW SCRN_&func + 268 ENDM + 269 + 270 0000 $D_SCRN: + 271 DSPNAM + 272 0000 0000 E + DW SCRN_EOF + 273 0002 0000 E + DW SCRN_LOC + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-2 + + + + 274 0004 0000 E + DW SCRN_LOF + 275 0006 00DE R + DW SCRN_CLOSE + 276 0008 007C R + DW SCRN_WIDTH + 277 000A 0000 E + DW SCRN_RANDIO + 278 000C 006C R + DW SCRN_OPEN + 279 000E 0000 E + DW SCRN_BAKC + 280 0010 0000 E + DW SCRN_SINP + 281 0012 0081 R + DW SCRN_SOUT + 282 0014 00D6 R + DW SCRN_GPOS + 283 0016 00D9 R + DW SCRN_GWID + 284 + 285 + 286 DSPMAC MACRO func + 287 DW KYBD_&func + 288 ENDM + 289 + 290 0018 $D_KYBD: + 291 DSPNAM + 292 0018 0000 E + DW KYBD_EOF + 293 001A 0000 E + DW KYBD_LOC + 294 001C 0000 E + DW KYBD_LOF + 295 001E 00DE R + DW KYBD_CLOSE + 296 0020 0000 E + DW KYBD_WIDTH + 297 0022 0000 E + DW KYBD_RANDIO + 298 0024 0034 R + DW KYBD_OPEN + 299 0026 0063 R + DW KYBD_BAKC + 300 0028 004D R + DW KYBD_SINP + 301 002A 0000 E + DW KYBD_SOUT + 302 002C 0000 E + DW KYBD_GPOS + 303 002E 0000 E + DW KYBD_GWID + 304 + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-3 + + + + 305 PAGE + 306 + 307 0030 devio PROC NEAR + 308 + 309 ; Keyboard routines + 310 + 311 0030 $I_KYBD: + 312 0030 $I_SCRN: + 313 0030 $C_KYBD: + 314 0030 $C_SCRN: + 315 0030 C3 RET + 316 + 317 0031 $W_KYBD: + 318 0031 E9 0000 E JMP KYBD_WIDTH + 319 + 320 + 321 0034 KYBD_OPEN: + 322 0034 51 PUSH CX + 323 0035 52 PUSH DX + 324 0036 53 PUSH BX + 325 0037 33 C9 XOR CX,CX ;(CX) = extra FDB size + 326 0039 88 0E 0001 R MOV [TTY_BAKFLG],CL ;Clear keyboard backup flag + 327 003D 33 D2 XOR DX,DX ;(DX) = (position,width) + 328 003F B4 01 MOV AH,MD_SQI ;Valid open modes + 329 + 330 0041 E8 0000 E opndev: CALL $DEVOPN ;Common routine + 331 0044 A0 0000 E MOV AL,[$FILMOD] + 332 0047 88 04 MOV [SI].FD_MODE,AL ;Set file mode + 333 0049 5B POP BX + 334 004A 5A POP DX + 335 004B 59 POP CX + 336 004C C3 RET + 337 + 338 + 339 004D $TTY_SINP: + 340 004D KYBD_SINP: + 341 004D 80 3E 0001 R 00 CMP [TTY_BAKFLG],0 + 342 0052 74 0A JE keyin + 343 + 344 0054 C6 06 0001 R 00 MOV [TTY_BAKFLG],0 + 345 0059 A0 0000 R MOV AL,[TTY_BAKCHR] + 346 005C F8 CLC + 347 005D C3 RET + 348 + 349 005E E8 0000 E keyin: CALL $TTYIN ;Get character + 350 0061 F8 CLC ;Clear carry + 351 0062 C3 RET + 352 + 353 + 354 0063 $TTY_BAKC: + 355 0063 KYBD_BAKC: + 356 0063 C6 06 0001 R 01 MOV [TTY_BAKFLG],1 ;Set flag + 357 0068 A2 0000 R MOV [TTY_BAKCHR],AL + 358 006B C3 RET + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-4 + + + + 359 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-5 + + + + 360 PAGE + 361 + 362 ; Screen routines + 363 + 364 006C SCRN_OPEN: + 365 006C E8 0000 E CALL $FRCSQO ;Force sequential output + 366 006F 51 PUSH CX + 367 0070 52 PUSH DX + 368 0071 53 PUSH BX + 369 0072 33 C9 XOR CX,CX ;(CX) = extra FDB size + 370 0074 8A 16 0000 E MOV DL,[$TTYWID] ;(DL) = position(ignored),width + 371 0078 B4 02 MOV AH,MD_SQO ;Set legal modes + 372 007A EB C5 JMP opndev ;Go to common routine + 373 + 374 + 375 007C $W_SCRN: + 376 007C SCRN_WIDTH: + 377 if _IBM_ + 378 XCHG DX,BX ;Switch for common call + 379 CALL $SCNWID ;Special for IBM + 380 XCHG DX,BX ;Switch back + 381 else + 382 007C 88 16 0000 E MOV [$TTYWID],DL + 383 endif + 384 0080 C3 RET + 385 + 386 + 387 = 0008 BS= 8 ;Backspace + 388 = 0009 TAB= 9 ;Tab + 389 = 000D CR= 13 ;Carriage return + 390 + 391 0081 $TTY_SOUT: + 392 0081 SCRN_SOUT: + 393 0081 32 E4 XOR AH,AH + 394 0083 3C 0D CMP AL,CR ;Check for CR + 395 0085 74 49 JE wch50 + 396 + 397 0087 3C 08 CMP AL,BS ;Check for backspace + 398 0089 75 0E JNE wch10 + 399 + 400 008B E8 0000 E CALL $LTTYPS ;(AH) = position + 401 008E 0A E4 OR AH,AH + 402 0090 74 02 JZ wch05 ; Already in 1st column + 403 0092 FE CC DEC AH ;Decrement column position + 404 0094 E8 0000 E wch05: CALL $STTYPS ;Save new position + 405 0097 EB 3A JMP SHORT wch ;Output character + 406 + 407 0099 3C 09 wch10: CMP AL,TAB ;Check for tab + 408 009B 75 15 JNE wch20 + 409 + 410 009D B0 20 wch11: MOV AL,' ' + 411 009F E8 0000 E CALL $$WCH ;Recursively tab + 412 00A2 E8 0000 E CALL $LTTYPS ;(AH) = position + 413 00A5 80 FC FF CMP AH,255 + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-6 + + + + 414 00A8 74 05 JE wch15 ;Stop counting at 255 + 415 00AA 80 E4 07 AND AH,7 + 416 00AD 75 EE JNZ wch11 ;More spacing to next column + 417 + 418 00AF B0 09 wch15: MOV AL,TAB ;Restore tab character + 419 00B1 C3 RET + 420 + 421 00B2 3C 20 wch20: CMP AL,' ' ;Check for printing character + 422 00B4 72 1D JB wch ; Not printing + 423 + 424 00B6 E8 0000 E CALL $LTTYPS + 425 00B9 80 3E 0000 E FF CMP $TTYWID,255 ;Check for infinite width + 426 00BE 74 09 JE wch25 + 427 + 428 00C0 3A 26 0000 E CMP AH,$TTYWID ;Check for last column + 429 00C4 75 03 JNE wch25 + 430 + 431 00C6 E8 0000 E CALL $$WCLF ;Yes - write CR/LF + 432 + 433 00C9 80 FC FF wch25: CMP AH,255 ;Stop counting at 255 + 434 00CC 74 05 JE wch + 435 + 436 00CE FE C4 INC AH ;Bump position + 437 + 438 00D0 E8 0000 E wch50: CALL $STTYPS ;Set position + 439 + 440 00D3 E9 0000 E wch: JMP $TTYOT + 441 + 442 + 443 00D6 $TTY_GPOS: + 444 00D6 SCRN_GPOS: + 445 00D6 E9 0000 E JMP $LTTYPS ;Get console position + 446 + 447 + 448 00D9 $TTY_GWID: + 449 00D9 SCRN_GWID: + 450 00D9 8A 26 0000 E MOV AH,$TTYWID ;(AH) = width + 451 00DD C3 RET + 452 + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Page 2-7 + + + + 453 PAGE + 454 + 455 ; Device Close Routines + 456 + 457 00DE KYBD_CLOSE: + 458 00DE SCRN_CLOSE: + 459 00DE E8 0000 E CALL $FBDEA ;Deallocate file block + 460 00E1 C3 RET + 461 + 462 + 463 00E2 devio ENDP + 464 + 465 00E2 Entries PROC FAR + 466 + 467 00E2 $WID: + 468 if _IBM_ + 469 CALL $SCHWID + 470 else + 471 00E2 88 1E 0000 E MOV [$TTYWID],BL ;WIDTH Statement + 472 endif + 473 00E6 CB RET + 474 + 475 + 476 00E7 50 $POS: PUSH AX ;POS Function + 477 00E8 E8 0000 E CALL $LTTYPS + 478 00EB 8A DC MOV BL,AH + 479 00ED 32 FF XOR BH,BH + 480 00EF 43 INC BX ;Map Pos to Base 1 + 481 00F0 58 POP AX + 482 00F1 CB RET + 483 + 484 00F2 Entries ENDP + 485 + 486 00F2 CODE ENDS + 487 + 488 END + + + + + + + + + + + + + + + + + + + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00F2 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0002 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +BS . . . . . . . . . . . . . . . Number 0008 +CR . . . . . . . . . . . . . . . Number 000D +DEVIO. . . . . . . . . . . . . . N PROC 0030 CODE Length =00B2 +DN_KYBD. . . . . . . . . . . . . Number FFFF + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Symbols-2 + + + +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +ENTRIES. . . . . . . . . . . . . F PROC 00E2 CODE Length =0010 +EOFCHR . . . . . . . . . . . . . Number 001A +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +KEYIN. . . . . . . . . . . . . . L NEAR 005E CODE +KYBD_BAKC. . . . . . . . . . . . L NEAR 0063 CODE +KYBD_CLOSE . . . . . . . . . . . L NEAR 00DE CODE +KYBD_EOF . . . . . . . . . . . . Alias $ERC_FC +KYBD_GPOS. . . . . . . . . . . . Alias $ERC_FC +KYBD_GWID. . . . . . . . . . . . Alias $ERC_FC +KYBD_LOC . . . . . . . . . . . . Alias $ERC_FC +KYBD_LOF . . . . . . . . . . . . Alias $ERC_FC +KYBD_OPEN. . . . . . . . . . . . L NEAR 0034 CODE +KYBD_RANDIO. . . . . . . . . . . Alias $ERC_FC +KYBD_SINP. . . . . . . . . . . . L NEAR 004D CODE +KYBD_SOUT. . . . . . . . . . . . Alias $ERC_FC +KYBD_WIDTH . . . . . . . . . . . Alias $ERC_FC +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +OPNDEV . . . . . . . . . . . . . L NEAR 0041 CODE +REC_LENGTH . . . . . . . . . . . Number 0080 +SCRN_BAKC. . . . . . . . . . . . Alias $ERC_FC +SCRN_CLOSE . . . . . . . . . . . L NEAR 00DE CODE +SCRN_EOF . . . . . . . . . . . . Alias $ERC_FC +SCRN_GPOS. . . . . . . . . . . . L NEAR 00D6 CODE +SCRN_GWID. . . . . . . . . . . . L NEAR 00D9 CODE +SCRN_LOC . . . . . . . . . . . . Alias $ERC_FC +SCRN_LOF . . . . . . . . . . . . Alias $ERC_FC +SCRN_OPEN. . . . . . . . . . . . L NEAR 006C CODE + + +IOTTY - Console driver for BASCOM-86 Macro-86 %1(12) 1:5:45 13-Nov-81 Symbols-3 + + + +SCRN_RANDIO. . . . . . . . . . . Alias $ERC_FC +SCRN_SINP. . . . . . . . . . . . Alias $ERC_FC +SCRN_SOUT. . . . . . . . . . . . L NEAR 0081 CODE +SCRN_WIDTH . . . . . . . . . . . L NEAR 007C CODE +TAB. . . . . . . . . . . . . . . Number 0009 +TTY_BAKCHR . . . . . . . . . . . L BYTE 0000 CONST +TTY_BAKFLG . . . . . . . . . . . L BYTE 0001 CONST +WCH. . . . . . . . . . . . . . . L NEAR 00D3 CODE +WCH05. . . . . . . . . . . . . . L NEAR 0094 CODE +WCH10. . . . . . . . . . . . . . L NEAR 0099 CODE +WCH11. . . . . . . . . . . . . . L NEAR 009D CODE +WCH15. . . . . . . . . . . . . . L NEAR 00AF CODE +WCH20. . . . . . . . . . . . . . L NEAR 00B2 CODE +WCH25. . . . . . . . . . . . . . L NEAR 00C9 CODE +WCH50. . . . . . . . . . . . . . L NEAR 00D0 CODE +$$WCH. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WCLF . . . . . . . . . . . . . L NEAR 0000 CODE External +$C_KYBD. . . . . . . . . . . . . L NEAR 0030 CODE Global +$C_SCRN. . . . . . . . . . . . . L NEAR 0030 CODE Global +$DEVOPN. . . . . . . . . . . . . L NEAR 0000 CODE External +$D_KYBD. . . . . . . . . . . . . L NEAR 0018 CODE Global +$D_SCRN. . . . . . . . . . . . . L NEAR 0000 CODE Global +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$FBDEA . . . . . . . . . . . . . L NEAR 0000 CODE External +$FILMOD. . . . . . . . . . . . . V BYTE 0000 DATA External +$FRCSQO. . . . . . . . . . . . . L NEAR 0000 CODE External +$I_KYBD. . . . . . . . . . . . . L NEAR 0030 CODE Global +$I_SCRN. . . . . . . . . . . . . L NEAR 0030 CODE Global +$LTTYPS. . . . . . . . . . . . . L NEAR 0000 CODE External +$POS . . . . . . . . . . . . . . L NEAR 00E7 CODE Global +$STTYPS. . . . . . . . . . . . . L NEAR 0000 CODE External +$TTYIN . . . . . . . . . . . . . L NEAR 0000 CODE External +$TTYOT . . . . . . . . . . . . . L NEAR 0000 CODE External +$TTYWID. . . . . . . . . . . . . V BYTE 0000 CONST External +$TTY_BAKC. . . . . . . . . . . . L NEAR 0063 CODE Global +$TTY_GPOS. . . . . . . . . . . . L NEAR 00D6 CODE Global +$TTY_GWID. . . . . . . . . . . . L NEAR 00D9 CODE Global +$TTY_SINP. . . . . . . . . . . . L NEAR 004D CODE Global +$TTY_SOUT. . . . . . . . . . . . L NEAR 0081 CODE Global +$WID . . . . . . . . . . . . . . L NEAR 00E2 CODE Global +$W_KYBD. . . . . . . . . . . . . L NEAR 0031 CODE Global +$W_SCRN. . . . . . . . . . . . . L NEAR 007C CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + + diff --git a/3_source_code/BASLIB-86/IOTTY.ASM b/3_source_code/BASLIB-86/IOTTY.ASM new file mode 100644 index 0000000..df66d55 --- /dev/null +++ b/3_source_code/BASLIB-86/IOTTY.ASM @@ -0,0 +1,270 @@ + TITLE IOTTY - Console driver for BASCOM-86 +PAGE 60,132 + + INCLUDE TABMAC.INC + + INCLUDE DEVDEF.INC + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FILMOD:BYTE + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $TTYWID:BYTE + +TTY_BAKCHR DB 0 +TTY_BAKFLG DB 0 ;Initially no character + +CONST ENDS + +DC GROUP CONST,DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + ASSUME CS:CODE, DS:DC, ES:DC + +; Run-time entries + + PUBLIC $WID,$POS + PUBLIC $D_KYBD,$I_KYBD,$C_KYBD,$W_KYBD + PUBLIC $D_SCRN,$I_SCRN,$C_SCRN,$W_SCRN + PUBLIC $TTY_BAKC,$TTY_SINP,$TTY_SOUT,$TTY_GPOS,$TTY_GWID + +; Run-time externals + + EXTRN $TTYIN:NEAR,$TTYOT:NEAR,$LTTYPS:NEAR,$STTYPS:NEAR + EXTRN $$WCH:NEAR,$$WCLF:NEAR + EXTRN $DEVOPN:NEAR,$FRCSQO:NEAR + EXTRN $FBDEA:NEAR + EXTRN $ERC_FC:NEAR +;IF _IBM_ +; EXTRN $SCNWID:NEAR +;ENDIF + + +; Illegal Device Functions + +KYBD_EOF EQU $ERC_FC +KYBD_LOC EQU $ERC_FC +KYBD_LOF EQU $ERC_FC +KYBD_WIDTH EQU $ERC_FC +KYBD_RANDIO EQU $ERC_FC +KYBD_SOUT EQU $ERC_FC +KYBD_GPOS EQU $ERC_FC +KYBD_GWID EQU $ERC_FC + +SCRN_EOF EQU $ERC_FC +SCRN_LOC EQU $ERC_FC +SCRN_LOF EQU $ERC_FC +SCRN_RANDIO EQU $ERC_FC +SCRN_BAKC EQU $ERC_FC +SCRN_SINP EQU $ERC_FC + + +; Devide Independent Console Interface + +DSPMAC MACRO func + DW SCRN_&func + ENDM + +$D_SCRN: + DSPNAM + + +DSPMAC MACRO func + DW KYBD_&func + ENDM + +$D_KYBD: + DSPNAM + + PAGE + +devio PROC NEAR + +; Keyboard routines + +$I_KYBD: +$I_SCRN: +$C_KYBD: +$C_SCRN: + RET + +$W_KYBD: + JMP KYBD_WIDTH + + +KYBD_OPEN: + PUSH CX + PUSH DX + PUSH BX + XOR CX,CX ;(CX) = extra FDB size + MOV [TTY_BAKFLG],CL ;Clear keyboard backup flag + XOR DX,DX ;(DX) = (position,width) + MOV AH,MD_SQI ;Valid open modes + +opndev: CALL $DEVOPN ;Common routine + MOV AL,[$FILMOD] + MOV [SI].FD_MODE,AL ;Set file mode + POP BX + POP DX + POP CX + RET + + +$TTY_SINP: +KYBD_SINP: + CMP [TTY_BAKFLG],0 + JE keyin + + MOV [TTY_BAKFLG],0 + MOV AL,[TTY_BAKCHR] + CLC + RET + +keyin: CALL $TTYIN ;Get character + CLC ;Clear carry + RET + + +$TTY_BAKC: +KYBD_BAKC: + MOV [TTY_BAKFLG],1 ;Set flag + MOV [TTY_BAKCHR],AL + RET + + PAGE + +; Screen routines + +SCRN_OPEN: + CALL $FRCSQO ;Force sequential output + PUSH CX + PUSH DX + PUSH BX + XOR CX,CX ;(CX) = extra FDB size + MOV DL,[$TTYWID] ;(DL) = position(ignored),width + MOV AH,MD_SQO ;Set legal modes + JMP opndev ;Go to common routine + + +$W_SCRN: +SCRN_WIDTH: +;if _IBM_ +; XCHG DX,BX ;Switch for common call +; CALL $SCNWID ;Special for IBM +; XCHG DX,BX ;Switch back +;else + MOV [$TTYWID],DL +;endif + RET + + +BS= 8 ;Backspace +TAB= 9 ;Tab +CR= 13 ;Carriage return + +$TTY_SOUT: +SCRN_SOUT: + XOR AH,AH + CMP AL,CR ;Check for CR + JE wch50 + + CMP AL,BS ;Check for backspace + JNE wch10 + + CALL $LTTYPS ;(AH) = position + OR AH,AH + JZ wch05 ; Already in 1st column + DEC AH ;Decrement column position +wch05: CALL $STTYPS ;Save new position + JMP SHORT wch ;Output character + +wch10: CMP AL,TAB ;Check for tab + JNE wch20 + +wch11: MOV AL,' ' + CALL $$WCH ;Recursively tab + CALL $LTTYPS ;(AH) = position + CMP AH,255 + JE wch15 ;Stop counting at 255 + AND AH,7 + JNZ wch11 ;More spacing to next column + +wch15: MOV AL,TAB ;Restore tab character + RET + +wch20: CMP AL,' ' ;Check for printing character + JB wch ; Not printing + + CALL $LTTYPS + CMP $TTYWID,255 ;Check for infinite width + JE wch25 + + CMP AH,$TTYWID ;Check for last column + JNE wch25 + + CALL $$WCLF ;Yes - write CR/LF + +wch25: CMP AH,255 ;Stop counting at 255 + JE wch + + INC AH ;Bump position + +wch50: CALL $STTYPS ;Set position + +wch: JMP $TTYOT + + +$TTY_GPOS: +SCRN_GPOS: + JMP $LTTYPS ;Get console position + + +$TTY_GWID: +SCRN_GWID: + MOV AH,$TTYWID ;(AH) = width + RET + + PAGE + +; Device Close Routines + +KYBD_CLOSE: +SCRN_CLOSE: + CALL $FBDEA ;Deallocate file block + RET + + +devio ENDP + +Entries PROC FAR + +$WID: +;if _IBM_ +; CALL $SCHWID +;else + MOV [$TTYWID],BL ;WIDTH Statement +;endif + RET + + +$POS: PUSH AX ;POS Function + CALL $LTTYPS + MOV BL,AH + XOR BH,BH + INC BX ;Map Pos to Base 1 + POP AX + RET + +Entries ENDP + +CODE ENDS + + END + From 9f01a7d40300352814f8eedca00a4c00f8abdd9b Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Mon, 20 Jul 2026 16:38:41 -0700 Subject: [PATCH 39/53] Transcription of Bundle 9 - LININP.ASM Code and Listing --- 2_printed_files/bundle_09/LININP.ASM | 120 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/LININP.ASM | 53 ++++++++++++ 2 files changed, 173 insertions(+) create mode 100644 2_printed_files/bundle_09/LININP.ASM create mode 100644 3_source_code/BASLIB-86/LININP.ASM diff --git a/2_printed_files/bundle_09/LININP.ASM b/2_printed_files/bundle_09/LININP.ASM new file mode 100644 index 0000000..74e5b35 --- /dev/null +++ b/2_printed_files/bundle_09/LININP.ASM @@ -0,0 +1,120 @@ +LININP - LINE INPUT statement Macro-86 %1(12) 1:6:2 13-Nov-18 Page 1-1 + + + + 1 TITLE LININP - LINE INPUT statement + 2 PAGE 60,132 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FILBUF:WORD,$INBUF:BYTE,$$ERRV:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 + 10 DC GROUP DATA + 11 + 12 + 13 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 14 + 15 PUBLIC $LIPA + 16 + 17 EXTRN $SAVREG:NEAR, $$CSL:NEAR, $$CTS:NEAR, $SAS:FAR, $CONT:NEAR + 18 + 19 ASSUME CS:CODE, DS:DC, ES:DC + 20 + 21 + 22 ;*** $LIPA - Assign LINE INPUT value + 23 ; + 24 ; Inputs: + 25 ; BX = Address of string variable to receive data + 26 ; Function: + 27 ; Assign the input line to the string variable. Either $IN0A or $IN0B + 28 ; is called first to set up either terminal or disk I/O. If terminal + 29 ; I/O, then the line is already read into $INBUF and $FILBUF contains + 30 ; the address of a RET instruction. If disk I/O, line will be read + 31 ; from disk by routine at $FILBUF. + 32 ; Outputs: + 33 ; None. + 34 ; Registers: + 35 ; Only F affected. + 36 + 37 0000 $LIPA: + 38 0000 E8 0000 E CALL $SAVREG + 39 0003 C7 06 0000 E 0000 E MOV [$$ERRV],OFFSET $CONT ;Reset error vector to normal + 40 0009 53 PUSH BX ;Remember destination + 41 000A 33 D2 XOR DX,DX ;Init for FILBUF, if disk I/O + 42 000C FF 16 0000 E CALL [$FILBUF] ;Read in line if disk I/O + 43 0010 BB 0000 E MOV BX,OFFSET DC:$INBUF + 44 0013 E8 0000 E CALL $$CSL ;Count length of line + 45 0016 8B D3 MOV DX,BX + 46 0018 93 XCHG AX,BX ;Need length in BX, address in DX + 47 0019 E8 0000 E CALL $$CTS ;Create temp string + 48 001C 5A POP DX ;Recall destination address + 49 001D 9A 0000 ---- E CALL $SAS ;Assign + 50 0022 C3 RET + 51 + 52 0023 CODE ENDS + 53 END + + + +LININP - LINE INPUT statement Macro-86 %1(12) 1:6:2 13-Nov-18 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0023 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +$$CSL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$CTS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$ERRV . . . . . . . . . . . . . V WORD 0000 DATA External +$CONT. . . . . . . . . . . . . . L NEAR 0000 CODE External +$FILBUF. . . . . . . . . . . . . V WORD 0000 DATA External +$INBUF . . . . . . . . . . . . . V BYTE 0000 DATA External +$LIPA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$SAS . . . . . . . . . . . . . . L FAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/LININP.ASM b/3_source_code/BASLIB-86/LININP.ASM new file mode 100644 index 0000000..d096332 --- /dev/null +++ b/3_source_code/BASLIB-86/LININP.ASM @@ -0,0 +1,53 @@ + TITLE LININP - LINE INPUT statement +PAGE 60,132 +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FILBUF:WORD,$INBUF:BYTE,$$ERRV:WORD + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $LIPA + + EXTRN $SAVREG:NEAR, $$CSL:NEAR, $$CTS:NEAR, $SAS:FAR, $CONT:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $LIPA - Assign LINE INPUT value +; +; Inputs: +; BX = Address of string variable to receive data +; Function: +; Assign the input line to the string variable. Either $IN0A or $IN0B +; is called first to set up either terminal or disk I/O. If terminal +; I/O, then the line is already read into $INBUF and $FILBUF contains +; the address of a RET instruction. If disk I/O, line will be read +; from disk by routine at $FILBUF. +; Outputs: +; None. +; Registers: +; Only F affected. + +$LIPA: + CALL $SAVREG + MOV [$$ERRV],OFFSET $CONT ;Reset error vector to normal + PUSH BX ;Remember destination + XOR DX,DX ;Init for FILBUF, if disk I/O + CALL [$FILBUF] ;Read in line if disk I/O + MOV BX,OFFSET DC:$INBUF + CALL $$CSL ;Count length of line + MOV DX,BX + XCHG AX,BX ;Need length in BX, address in DX + CALL $$CTS ;Create temp string + POP DX ;Recall destination address + CALL $SAS ;Assign + RET + +CODE ENDS + END From 9b742a8898766f9343f87a450415884b460f8639 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 21 Jul 2026 15:15:18 -0700 Subject: [PATCH 40/53] Transcription of Bundle 9 - LOG.ASM Code and Listing --- 2_printed_files/bundle_09/LOG.ASM | 240 ++++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/LOG.ASM | 118 +++++++++++++++ 2 files changed, 358 insertions(+) create mode 100644 2_printed_files/bundle_09/LOG.ASM create mode 100644 3_source_code/BASLIB-86/LOG.ASM diff --git a/2_printed_files/bundle_09/LOG.ASM b/2_printed_files/bundle_09/LOG.ASM new file mode 100644 index 0000000..f4c4fbf --- /dev/null +++ b/2_printed_files/bundle_09/LOG.ASM @@ -0,0 +1,240 @@ +LOG - Natural and base 2 logarithm Macro-86 %1(12) 1:6:6 13-Nov-81 Page 1-1 + + + + 1 TITLE LOG - Natural and base 2 logarithm + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $AC:WORD, $FAC:BYTE, $ARG:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 + 10 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 11 + 12 EXTRN $LN2:WORD + 13 + 14 ;Coefficient tables for Hart's 2524. Absolute error 8.32, range [1/2,1]. + 15 ;LOG2(x) = P(x) / Q(x) + 16 ; These constants have been checked with MuMath + 17 + 18 0000 0003 LOGPTAB DW 3 ;Degree 3 polynomial + 19 0002 9A F7 19 83 DB 09AH,0F7H,019H,083H ;+4.8114 74609 89 + 20 0006 24 63 43 83 DB 024H,063H,043H,083H ;+6.1058 51990 15 + 21 000A 75 CD 8D 84 DB 075H,0CDH,08DH,084H ;-8.8626 59939 1 + 22 000E A9 7F 83 82 DB 0A9H,07FH,083H,082H ;-2.0546 66719 51 + 23 + 24 0012 0003 LOGQTAB DW 3 ;Degree 3 polynomial + 25 0014 00 00 00 81 DB 000H,000H,000H,081H ;+1 + 26 0018 E2 B0 4D 83 DB 0E2H,0B0H,04DH,083H ;+6.4278 42090 29 + 27 001C 0A 72 11 83 DB 00AH,072H,011H,083H ;+4.5451 70876 29 + 28 0020 F4 04 35 7F DB 0F4H,004H,035H,07FH ;+0.35355 34252 77 + 29 + 30 0024 CONST ENDS + 31 + 32 + 33 DC GROUP DATA,CONST + 34 + 35 + 36 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 37 + 38 PUBLIC $LOG,$LOG2 + 39 + 40 EXTRN $SMUL:NEAR, $SPOLY:NEAR, $SADD:NEAR, $CISA:FAR + 41 EXTRN $SAVREG:NEAR, $ERC_FC:NEAR, $SDIV:NEAR + 42 + 43 ASSUME CS:CODE, DS:DC, ES:DC + 44 + 45 + 46 ;*** $LOG - LOG (base e) function + 47 ; + 48 ; Inputs: + 49 ; BX = Address of operand + 50 ; Outputs: + 51 ; Result in FAC + 52 ; Registers: + 53 ; Only F affected. + 54 + + +LOG - Natural and base 2 logarithm Macro-86 %1(12) 1:6:6 13-Nov-81 Page 1-2 + + + + 55 0000 $LOG: + 56 0000 E8 0000 E CALL $SAVREG + 57 0003 8B F3 MOV SI,BX + 58 0005 BF 0000 E MOV DI,OFFSET DC:$AC + 59 0008 A5 MOVSW ;Put operand in FAC + 60 0009 A5 MOVSW + 61 000A E8 0016 R CALL $LOG2 ;Compute log base 2 + 62 000D BE 0000 E MOV SI,OFFSET DC:$AC + 63 0010 BF 0000 E MOV DI,OFFSET DC:$LN2 + 64 0013 E9 0000 E JMP $SMUL + 65 + 66 + 67 ;*** $LOG2 - Log (base two) + 68 ; + 69 ; Inputs: + 70 ; Number in FAC + 71 ; Function: + 72 ; Compute Log base 2, using relation LOG2(X*2^Y) = LOG2(2^Y) + LOG2(X) = + 73 ; Y + LOG2(X), 0.5 <= X < 1 + 74 ; Outputs: + 75 ; Result in FAC + 76 ; Registers: + 77 ; All registers destroyed. + 78 + 79 0016 $LOG2: + 80 0016 A1 0002 E MOV AX,[$AC+2] + 81 0019 0A E4 OR AH,AH ;Taking log of zero? + 82 001B 74 53 JZ ARGERR + 83 001D 0A C0 OR AL,AL ;Log of negative number? + 84 001F 78 4F JS ARGERR + 85 0021 C6 06 0000 E 80 MOV [$FAC],80H ;Assign a zero exponent + 86 0026 8A C4 MOV AL,AH ;Convert exponent to 16-bit integer + 87 0028 2C 80 SUB AL,80H ; Remove bias + 88 002A 98 CBW + 89 002B 50 PUSH AX + 90 002C FF 36 0000 E PUSH [$AC] + 91 0030 FF 36 0002 E PUSH [$AC+2] ;Save FAC for figuring Q(x) + 92 0034 BB 0000 R MOV BX,OFFSET DC:LOGPTAB + 93 0037 E8 0000 E CALL $SPOLY ;Compute P(x) polynomial on mantissa + 94 003A BE 0000 E MOV SI,OFFSET DC:$AC + 95 003D BF 0004 E MOV DI,OFFSET DC:$ARG+4 + 96 0040 A5 MOVSW + 97 0041 A5 MOVSW ;Hold P(x) in temp while we compute Q(x) + 98 0042 8F 06 0002 E POP [$AC+2] + 99 0046 8F 06 0000 E POP [$AC] + 100 004A BB 0012 R MOV BX,OFFSET DC:LOGQTAB + 101 004D E8 0000 E CALL $SPOLY ;Compute Q(x) + 102 0050 BE 0004 E MOV SI,OFFSET DC:$ARG+4 + 103 0053 BF 0000 E MOV DI,OFFSET DC:$AC + 104 0056 E8 0000 E CALL $SDIV ;LOG2(x) = P(x) / Q(x) + 105 0059 BE 0000 E MOV SI,OFFSET DC:$AC + 106 005C BF 0000 E MOV DI,OFFSET DC:$ARG + 107 005F A5 MOVSW ;Set result aside in ARG + 108 0060 A5 MOVSW + + +LOG - Natural and base 2 logarithm Macro-86 %1(12) 1:6:6 13-Nov-81 Page 1-3 + + + + 109 0061 5B POP BX ;Recover exponent (as integer) + 110 0062 9A 0000 ---- E CALL $CISA ;Convert it to S.P. + 111 0067 BE 0000 E MOV SI,OFFSET DC:$AC + 112 006A BF 0000 E MOV DI,OFFSET DC:$ARG + 113 006D E9 0000 E JMP $SADD + 114 + 115 0070 E9 0000 E ARGERR: JMP $ERC_FC + 116 + 117 0073 CODE ENDS + 118 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +LOG - Natural and base 2 logarithm Macro-86 %1(12) 1:6:6 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0073 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + CONST. . . . . . . . . . . . . . 0024 WORD PUBLIC 'CONST' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 0070 CODE +LOGPTAB. . . . . . . . . . . . . L WORD 0000 CONST +LOGQTAB. . . . . . . . . . . . . L WORD 0012 CONST +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$CISA. . . . . . . . . . . . . . L FAR 0000 CODE External +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$LN2 . . . . . . . . . . . . . . V WORD 0000 CONST External +$LOG . . . . . . . . . . . . . . L NEAR 0000 CODE Global +$LOG2. . . . . . . . . . . . . . L NEAR 0016 CODE Global +$SADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SPOLY . . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/LOG.ASM b/3_source_code/BASLIB-86/LOG.ASM new file mode 100644 index 0000000..84c930e --- /dev/null +++ b/3_source_code/BASLIB-86/LOG.ASM @@ -0,0 +1,118 @@ + TITLE LOG - Natural and base 2 logarithm +PAGE 60,132 +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $AC:WORD, $FAC:BYTE, $ARG:WORD + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $LN2:WORD + +;Coefficient tables for Hart's 2524. Absolute error 8.32, range [1/2,1]. +;LOG2(x) = P(x) / Q(x) +; These constants have been checked with MuMath + +LOGPTAB DW 3 ;Degree 3 polynomial + DB 09AH,0F7H,019H,083H ;+4.8114 74609 89 + DB 024H,063H,043H,083H ;+6.1058 51990 15 + DB 075H,0CDH,08DH,084H ;-8.8626 59939 1 + DB 0A9H,07FH,083H,082H ;-2.0546 66719 51 + +LOGQTAB DW 3 ;Degree 3 polynomial + DB 000H,000H,000H,081H ;+1 + DB 0E2H,0B0H,04DH,083H ;+6.4278 42090 29 + DB 00AH,072H,011H,083H ;+4.5451 70876 29 + DB 0F4H,004H,035H,07FH ;+0.35355 34252 77 + +CONST ENDS + + +DC GROUP DATA,CONST + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $LOG,$LOG2 + + EXTRN $SMUL:NEAR, $SPOLY:NEAR, $SADD:NEAR, $CISA:FAR + EXTRN $SAVREG:NEAR, $ERC_FC:NEAR, $SDIV:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $LOG - LOG (base e) function +; +; Inputs: +; BX = Address of operand +; Outputs: +; Result in FAC +; Registers: +; Only F affected. + +$LOG: + CALL $SAVREG + MOV SI,BX + MOV DI,OFFSET DC:$AC + MOVSW ;Put operand in FAC + MOVSW + CALL $LOG2 ;Compute log base 2 + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$LN2 + JMP $SMUL + + +;*** $LOG2 - Log (base two) +; +; Inputs: +; Number in FAC +; Function: +; Compute Log base 2, using relation LOG2(X*2^Y) = LOG2(2^Y) + LOG2(X) = +; Y + LOG2(X), 0.5 <= X < 1 +; Outputs: +; Result in FAC +; Registers: +; All registers destroyed. + +$LOG2: + MOV AX,[$AC+2] + OR AH,AH ;Taking log of zero? + JZ ARGERR + OR AL,AL ;Log of negative number? + JS ARGERR + MOV [$FAC],80H ;Assign a zero exponent + MOV AL,AH ;Convert exponent to 16-bit integer + SUB AL,80H ; Remove bias + CBW + PUSH AX + PUSH [$AC] + PUSH [$AC+2] ;Save FAC for figuring Q(x) + MOV BX,OFFSET DC:LOGPTAB + CALL $SPOLY ;Compute P(x) polynomial on mantissa + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG+4 + MOVSW + MOVSW ;Hold P(x) in temp while we compute Q(x) + POP [$AC+2] + POP [$AC] + MOV BX,OFFSET DC:LOGQTAB + CALL $SPOLY ;Compute Q(x) + MOV SI,OFFSET DC:$ARG+4 + MOV DI,OFFSET DC:$AC + CALL $SDIV ;LOG2(x) = P(x) / Q(x) + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG + MOVSW ;Set result aside in ARG + MOVSW + POP BX ;Recover exponent (as integer) + CALL $CISA ;Convert it to S.P. + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG + JMP $SADD + +ARGERR: JMP $ERC_FC + +CODE ENDS + END From ec822bf08fe411d1c8c0957f7ac4b6e1bb1c1938 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 21 Jul 2026 16:00:57 -0700 Subject: [PATCH 41/53] Removed formatting remnants accidentally left in source code --- 3_source_code/BASLIB-86/IODEV.ASM | 2 +- 3_source_code/BASLIB-86/IODISK.ASM | 2 +- 3_source_code/BASLIB-86/IOFILM.ASM | 2 +- 3_source_code/BASLIB-86/IOLPT.ASM | 2 +- 3_source_code/BASLIB-86/IOTTY.ASM | 2 +- 3_source_code/BASLIB-86/LININP.ASM | 2 +- 3_source_code/BASLIB-86/LOG.ASM | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/3_source_code/BASLIB-86/IODEV.ASM b/3_source_code/BASLIB-86/IODEV.ASM index e85732b..7c4d980 100644 --- a/3_source_code/BASLIB-86/IODEV.ASM +++ b/3_source_code/BASLIB-86/IODEV.ASM @@ -1,5 +1,5 @@ TITLE IODEV - Device Independent I/O Drivers for BASCOM-86 -PAGE 60,132 + ; This module contains the device independent I/O drivers for the ; 8086 BASIC Compiler runtime. diff --git a/3_source_code/BASLIB-86/IODISK.ASM b/3_source_code/BASLIB-86/IODISK.ASM index 2ab3ad4..c9d48d0 100644 --- a/3_source_code/BASLIB-86/IODISK.ASM +++ b/3_source_code/BASLIB-86/IODISK.ASM @@ -1,5 +1,5 @@ TITLE IODISK - Disk I/O Drivers for BASCOM-86 -PAGE 60,132 + ; This module contains the disk operating system interface ; for the device I/O independent package. It also includes ; other operating system features of BASIC. diff --git a/3_source_code/BASLIB-86/IOFILM.ASM b/3_source_code/BASLIB-86/IOFILM.ASM index 6e5ffeb..3422c57 100644 --- a/3_source_code/BASLIB-86/IOFILM.ASM +++ b/3_source_code/BASLIB-86/IOFILM.ASM @@ -1,5 +1,5 @@ TITLE IOFILM - File Manager for BASCOM-86 -PAGE 60,132 + ; This module contains the dynamic file management routines for the ; 8086 BASIC Compiler runtime. diff --git a/3_source_code/BASLIB-86/IOLPT.ASM b/3_source_code/BASLIB-86/IOLPT.ASM index 308e085..7bdc18a 100644 --- a/3_source_code/BASLIB-86/IOLPT.ASM +++ b/3_source_code/BASLIB-86/IOLPT.ASM @@ -1,6 +1,6 @@ TITLE IOLPT - Line printer Device Drivers SUBTTL Support for 1 line printers -PAGE 60,132 + ; This module contains the device independent printer routines for ; the BASIC Compiler. While this module is intended for use with diff --git a/3_source_code/BASLIB-86/IOTTY.ASM b/3_source_code/BASLIB-86/IOTTY.ASM index df66d55..e11c5f7 100644 --- a/3_source_code/BASLIB-86/IOTTY.ASM +++ b/3_source_code/BASLIB-86/IOTTY.ASM @@ -1,5 +1,5 @@ TITLE IOTTY - Console driver for BASCOM-86 -PAGE 60,132 + INCLUDE TABMAC.INC diff --git a/3_source_code/BASLIB-86/LININP.ASM b/3_source_code/BASLIB-86/LININP.ASM index d096332..438b058 100644 --- a/3_source_code/BASLIB-86/LININP.ASM +++ b/3_source_code/BASLIB-86/LININP.ASM @@ -1,5 +1,5 @@ TITLE LININP - LINE INPUT statement -PAGE 60,132 + DATA SEGMENT WORD PUBLIC 'DATA' EXTRN $FILBUF:WORD,$INBUF:BYTE,$$ERRV:WORD diff --git a/3_source_code/BASLIB-86/LOG.ASM b/3_source_code/BASLIB-86/LOG.ASM index 84c930e..b45d4c3 100644 --- a/3_source_code/BASLIB-86/LOG.ASM +++ b/3_source_code/BASLIB-86/LOG.ASM @@ -1,5 +1,5 @@ TITLE LOG - Natural and base 2 logarithm -PAGE 60,132 + DATA SEGMENT WORD PUBLIC 'DATA' EXTRN $AC:WORD, $FAC:BYTE, $ARG:WORD From c8642223f7972ad9ab689e62b341fdb4299b8575 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 21 Jul 2026 16:16:22 -0700 Subject: [PATCH 42/53] Transcription of Bundle 9 - MID.ASM Code and Listing --- 2_printed_files/bundle_09/MID.ASM | 180 ++++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/MID.ASM | 71 ++++++++++++ 2 files changed, 251 insertions(+) create mode 100644 2_printed_files/bundle_09/MID.ASM create mode 100644 3_source_code/BASLIB-86/MID.ASM diff --git a/2_printed_files/bundle_09/MID.ASM b/2_printed_files/bundle_09/MID.ASM new file mode 100644 index 0000000..467d7a8 --- /dev/null +++ b/2_printed_files/bundle_09/MID.ASM @@ -0,0 +1,180 @@ +MID - Left-hand MID$ Macro-86 %1(12) 1:6:11 13-Nov-81 Page 1-1 + + + + 1 TITLE MID - Left-hand MID$ + 2 PAGE 60,132 + 3 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 4 + 5 PUBLIC $MD$A + 6 + 7 EXTRN $$DITS:NEAR, $ERR_FC:NEAR + 8 + 9 ASSUME CS:CODE + 10 + 11 0000 $MD$A PROC FAR ;Set up for long returns + 12 + 13 + 14 ;*** $MD$A - MID$ statement + 15 ; + 16 ; Inputs: + 17 ; DX = Address of Destination string descriptor + 18 ; BX = Address of Source string descriptor + 19 ; CX = Starting offset in Destination + 20 ; AX = Max. length of copy + 21 ; Function: + 22 ; Copy the source string into the destination string. Copying limited to + 23 ; present length of destination. + 24 ; Outputs: + 25 ; None. + 26 ; Registers: + 27 ; Only F affected. + 28 + 29 0000 87 D3 XCHG DX,BX + 30 0002 0B C9 OR CX,CX ;Test for valid offset + 31 0004 7E 36 JLE ARGERR ;Must be greater than zero + 32 0006 0B C0 OR AX,AX ;Test for valid length + 33 0008 7C 32 JL ARGERR ;Must be zero or more + 34 000A 3B 0F CMP CX,[BX] ;Compare offset to current length of string + 35 000C 77 2E JA ARGERR ;Offset must not exceed string size + 36 000E 56 PUSH SI + 37 000F 57 PUSH DI + 38 0010 51 PUSH CX + 39 0011 8B 7F 02 MOV DI,[BX+2] ;Pointer to destination data + 40 0014 49 DEC CX ;Need offset starting at 0, not 1 + 41 0015 03 F9 ADD DI,CX ;Add in offset + 42 0017 2B 0F SUB CX,[BX] + 43 0019 F7 D9 NEG CX ;Length - Offset + 44 001B 3B C8 CMP CX,AX ;Take minimum of this and count parameter + 45 001D 72 02 JB MIN1 + 46 001F 8B C8 MOV CX,AX ;Count parameter was lower + 47 0021 MIN1: + 48 0021 8B F2 MOV SI,DX ;Get source where we can address with it + 49 0023 3B 0C CMP CX,[SI] ;Compare current move length to string length + 50 0025 76 02 JBE MIN2 + 51 0027 8B 0C MOV CX,[SI] ;Source string was smaller + 52 0029 MIN2: + 53 0029 8B 74 02 MOV SI,[SI+2] ;Get pointer to source data + 54 002C D1 E9 SHR CX,1 ;Convert byte count to word count + + +MID - Left-hand MID$ Macro-86 %1(12) 1:6:11 13-Nov-81 Page 1-2 + + + + 55 002E F3/ A5 REP MOVSW + 56 0030 73 01 JNC EVENMOV ;Was count odd? + 57 0032 A4 MOVSB ;Move that last byte + 58 0033 EVENMOV: + 59 0033 59 POP CX + 60 0034 5F POP DI + 61 0035 5E POP SI + 62 0036 87 DA XCHG BX,DX ;Need source addr. in BX + 63 0038 E8 0000 E CALL $$DITS ;Delete source if temp string + 64 003B CB RET + 65 + 66 003C ARGERR: + 67 003C E9 0000 E JMP $ERR_FC ;Illegal function call + 68 + 69 003F $MD$A ENDP + 70 003F CODE ENDS + 71 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +MID - Left-hand MID$ Macro-86 %1(12) 1:6:11 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 003F BYTE PUBLIC 'CODE' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 003C CODE +EVENMOV. . . . . . . . . . . . . L NEAR 0033 CODE +MIN1 . . . . . . . . . . . . . . L NEAR 0021 CODE +MIN2 . . . . . . . . . . . . . . L NEAR 0029 CODE +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External +$ERR_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$MD$A. . . . . . . . . . . . . . F PROC 0000 CODE Global Length =003F + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/MID.ASM b/3_source_code/BASLIB-86/MID.ASM new file mode 100644 index 0000000..04fe98c --- /dev/null +++ b/3_source_code/BASLIB-86/MID.ASM @@ -0,0 +1,71 @@ + TITLE MID - Left-hand MID$ + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $MD$A + + EXTRN $$DITS:NEAR, $ERR_FC:NEAR + + ASSUME CS:CODE + +$MD$A PROC FAR ;Set up for long returns + + +;*** $MD$A - MID$ statement +; +; Inputs: +; DX = Address of Destination string descriptor +; BX = Address of Source string descriptor +; CX = Starting offset in Destination +; AX = Max. length of copy +; Function: +; Copy the source string into the destination string. Copying limited to +; present length of destination. +; Outputs: +; None. +; Registers: +; Only F affected. + + XCHG DX,BX + OR CX,CX ;Test for valid offset + JLE ARGERR ;Must be greater than zero + OR AX,AX ;Test for valid length + JL ARGERR ;Must be zero or more + CMP CX,[BX] ;Compare offset to current length of string + JA ARGERR ;Offset must not exceed string size + PUSH SI + PUSH DI + PUSH CX + MOV DI,[BX+2] ;Pointer to destination data + DEC CX ;Need offset starting at 0, not 1 + ADD DI,CX ;Add in offset + SUB CX,[BX] + NEG CX ;Length - Offset + CMP CX,AX ;Take minimum of this and count parameter + JB MIN1 + MOV CX,AX ;Count parameter was lower +MIN1: + MOV SI,DX ;Get source where we can address with it + CMP CX,[SI] ;Compare current move length to string length + JBE MIN2 + MOV CX,[SI] ;Source string was smaller +MIN2: + MOV SI,[SI+2] ;Get pointer to source data + SHR CX,1 ;Convert byte count to word count + REP MOVSW + JNC EVENMOV ;Was count odd? + MOVSB ;Move that last byte +EVENMOV: + POP CX + POP DI + POP SI + XCHG BX,DX ;Need source addr. in BX + CALL $$DITS ;Delete source if temp string + RET + +ARGERR: + JMP $ERR_FC ;Illegal function call + +$MD$A ENDP +CODE ENDS + END From e1002efbe539eba86f484559b68740f2cb0f831e Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 23 Jul 2026 18:59:20 -0700 Subject: [PATCH 43/53] Transcription of Bundle 9 - NUMFCN.ASM Code and Listing --- 2_printed_files/bundle_09/NUMFCN.ASM | 600 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/NUMFCN.ASM | 404 ++++++++++++++++++ 2 files changed, 1004 insertions(+) create mode 100644 2_printed_files/bundle_09/NUMFCN.ASM create mode 100644 3_source_code/BASLIB-86/NUMFCN.ASM diff --git a/2_printed_files/bundle_09/NUMFCN.ASM b/2_printed_files/bundle_09/NUMFCN.ASM new file mode 100644 index 0000000..03c2de4 --- /dev/null +++ b/2_printed_files/bundle_09/NUMFCN.ASM @@ -0,0 +1,600 @@ +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-1 + + + + 1 TITLE NUMFCN - Arithmetic functions + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $FAC:BYTE, $AC:WORD, $DAC:WORD + 6 + 7 0000 ???? SISAVE DW ? + 8 + 9 0002 DATA ENDS + 10 + 11 + 12 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 13 + 14 0000 00 80 C0 E0 F0 F8 FIXTAB DB 0,80H,0C0H,0E0H,0F0H,0F8H,0FCH,0FEH + 15 FC FE + 16 + 17 0008 CONST ENDS + 18 + 19 DC GROUP CONST,DATA + 20 + 21 + 22 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 23 + 24 PUBLIC $FUMA,$FUMB,$FUMC,$FUMD,$SGNA,$SGNB,$SGNC,$SGND + 25 PUBLIC $FC0A,$FC0B,$FC0C,$FC0D,$CNZA,$CNZB,$CNZC,$CNZD + 26 PUBLIC $FIX, $FID, $INT, $IND, $ABSA,$ABSB,$ABSC,$ABSD + 27 PUBLIC $FSHA,$FSHB,$FSHC,$FSHD + 28 + 29 EXTRN $OVFL:NEAR + 30 + 31 ASSUME CS:CODE, DS:DC, ES:DC + 32 + 33 0000 NUMFCN PROC FAR ;Set up long returns + 34 + 35 + 36 ;*** $FUM - Floating unary minus + 37 ; + 38 ; Inputs: + 39 ; SI = Address of argument ($FUMA/$FUMB) + 40 ; $FAC has argument ($FUMC/$FUMD) + 41 ; Function: + 42 ; Invert sign + 43 ; Outputs: + 44 ; Result in FAC. + 45 ; Registers: + 46 ; Only F affected. + 47 + 48 0000 $FUMA: ;Single precision + 49 0000 E8 0178 R CALL PUTAC + 50 0003 $FUMC: + 51 0003 80 36 FFFF E 80 XOR [$FAC-1],80H + 52 0008 CB RET + 53 + 54 0009 $FUMB: ;Double precision + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-2 + + + + 55 0009 E8 0183 R CALL PUTDAC + 56 000C $FUMD: + 57 000C 80 36 FFFF E 80 XOR [$FAC-1],80H + 58 0011 CB RET + 59 + 60 + 61 ;*** $SIGN - SGN function + 62 ; + 63 ; Inputs: + 64 ; SI = Address of argument ($SGNA/$SGNB) + 65 ; FAC has argument ($SGNC/$SGND) + 66 ; Function: + 67 ; Return 1 if argument positive + 68 ; Return 0 if argument zero + 69 ; Return -1 if argument negative + 70 ; Outputs: + 71 ; FAC has result, same type as argument + 72 ; Registers: + 73 ; Only F affected. + 74 + 75 0012 $SGNA: ;Single precision + 76 0012 50 PUSH AX + 77 0013 8B 44 02 MOV AX,[SI+2] ;Get sign and exponent + 78 0016 EB 04 JMP SHORT SGN + 79 + 80 0018 $SGNC: + 81 0018 $SGND: + 82 0018 50 PUSH AX + 83 0019 A1 0002 E MOV AX,[$AC+2] + 84 001C SGN: + 85 001C 0A E4 OR AH,AH ;Check exponent for zero + 86 001E 74 04 JZ SAVSGN + 87 0020 B4 81 MOV AH,81H ;Set exponent for +1 or -1 + 88 0022 24 80 AND AL,80H ;Reduce to sign bit + 89 0024 SAVSGN: + 90 0024 A3 0002 E MOV [$AC+2],AX + 91 0027 33 C0 XOR AX,AX + 92 0029 A3 0000 E MOV [$DAC],AX + 93 002C A3 0002 E MOV [$DAC+2],AX + 94 002F A3 0000 E MOV [$AC],AX + 95 0032 58 POP AX + 96 0033 CB RET + 97 + 98 0034 $SGNB: ;Double precision + 99 0034 50 PUSH AX + 100 0035 8B 44 06 MOV AX,[SI+6] ;Get sign and exponent + 101 0038 EB E2 JMP SGN + 102 + 103 + 104 ;*** $FC0 - Floating compare for zero + 105 ; + 106 ; Inputs: + 107 ; SI = Address of argument ($FC0A/$FC0B) + 108 ; $FAC has argument ($FC0C/$FC0D) + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-3 + + + + 109 ; Function: + 110 ; Compare the floating point number against zero, setting ZF and CF. + 111 ; Outputs: + 112 ; Positive: ZF=0, CF=0, Zero: ZF=1, CF=0; Negative: ZF=0, CF=1. + 113 ; Registers: + 114 ; Only F affected. + 115 + 116 003A $FC0A: ;Single precision + 117 003A 50 PUSH AX + 118 003B 8B 44 02 MOV AX,[SI+2] + 119 003E FC0: + 120 003E 0A E4 OR AH,AH ;Exponent zero? + 121 0040 74 02 JZ PRET + 122 0042 D0 D0 RCL AL,1 ;Rotate sign into carry + 123 0044 PRET: + 124 0044 58 POP AX + 125 0045 CB RET + 126 + 127 0046 $FC0B: ;Double precision + 128 0046 50 PUSH AX + 129 0047 8B 44 06 MOV AX,[SI+6] + 130 004A EB F2 JMP FC0 + 131 + 132 004C $FC0C: + 133 004C $FC0D: + 134 004C 50 PUSH AX + 135 004D A1 0002 E MOV AX,[$AC+2] + 136 0050 EB EC JMP FC0 + 137 + 138 + 139 ;*** $CNZ - Compare for non-zero + 140 ; + 141 ; Inputs: + 142 ; SI = Address of argument ($CNZA/$CNZB) + 143 ; $FAC has argument ($CNZC/$CNZD) + 144 ; Function: + 145 ; Return integer 0 if argument 0, integer -1 otherwise + 146 ; Outputs: + 147 ; Result in BX + 148 ; Registers: + 149 ; Only BX affected. + 150 + 151 0052 $CNZA: ;Single precision + 152 0052 33 DB XOR BX,BX + 153 0054 80 7C 03 00 CMP BYTE PTR[SI+3],0 + 154 0058 74 16 JZ RET + 155 005A 4B DEC BX + 156 005B CB RET + 157 + 158 005C $CNZB: ;Double precision + 159 005C 33 DB XOR BX,BX + 160 005E 80 7C 07 00 CMP BYTE PTR[SI+7],0 + 161 0062 74 0C JZ RET + 162 0064 4B DEC BX + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-4 + + + + 163 0065 CB RET + 164 + 165 0066 $CNZC: + 166 0066 $CNZD: + 167 0066 33 DB XOR BX,BX + 168 0068 80 3E 0000 E 00 CMP [$FAC],0 + 169 006D 74 01 JZ RET + 170 006F 4B DEC BX + 171 0070 CB RET: RET + 172 + 173 + 174 ;*** $ABS - Absolute value function + 175 ; + 176 ; Inputs: + 177 ; SI = Address of argument ($ABSA/$ABSC) + 178 ; FAC = argument ($ABSB/$ABSD) + 179 ; Outputs: + 180 ; Absolute value in FAC + 181 ; Registers: + 182 ; Only F affected. + 183 + 184 0071 $ABSA: ;Single precision + 185 0071 E8 0178 R CALL PUTAC + 186 0074 80 26 FFFF E 7F $ABSC: AND [$FAC-1],7FH ;Force sign positive + 187 0079 CB RET + 188 + 189 007A $ABSB: ;Double precision + 190 007A E8 0183 R CALL PUTDAC + 191 007D 80 26 FFFF E 7F $ABSD: AND [$FAC-1],7FH + 192 0082 CB RET + 193 + 194 + 195 ;*** $FSH - Floating shift + 196 ; + 197 ; Inputs: + 198 ; SI = Address of argument ($FSHA/$FSHB) + 199 ; $FAC has argument ($FSHC/$FSHD) + 200 ; Long return address on top of stack pointer to a byte. + 201 ; Function: + 202 ; Add byte to exponent of floating point number. + 203 ; Outputs: + 204 ; Result in FAC. + 205 ; Registers: + 206 ; Only F affected. + 207 + 208 0083 $FSHA: ;Single precision + 209 0083 E8 0178 R CALL PUTAC + 210 0086 $FSHC: + 211 0086 $FSHD: + 212 0086 89 36 0000 R MOV [SISAVE],SI + 213 008A 5E POP SI + 214 008B 1F POP DS ;Get pointer to power + 215 008C 50 PUSH AX + 216 008D AC LODSB + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-5 + + + + 217 008E 00 06 0000 E ADD [$FAC],AL ;Add byte to exponent + 218 0092 58 POP AX + 219 0093 1E PUSH DS + 220 0094 56 PUSH SI + 221 0095 06 PUSH ES + 222 0096 1F POP DS ;Restore DS + 223 0097 8B 36 0000 R MOV SI,[SISAVE] + 224 009B 73 D3 JNC RET + 225 009D E9 0000 E JMP $OVFL + 226 + 227 00A0 $FSHB: + 228 00A0 E8 0183 R CALL PUTDAC + 229 00A3 EB E1 JMP $FSHD + 230 + 231 + 232 ;*** $FIX - Get integer part of argument, chopped toward zero + 233 ; + 234 ; Inputs: + 235 ; BX = Address of argument + 236 ; Function: + 237 ; Compute integer part, chopped toward zero (-12.5 -> -12). + 238 ; $FIX is for single precision, $FID is for double precision. + 239 ; Outputs: + 240 ; Result in $FAC, same type as argument (SP or DP) + 241 ; Registers: + 242 ; Only F affected. + 243 + 244 00A5 $FIX: ;Single precision + 245 00A5 87 F3 XCHG SI,BX + 246 00A7 E8 0178 R CALL PUTAC + 247 00AA 87 F3 XCHG SI,BX + 248 00AC 51 PUSH CX + 249 00AD B9 0002 MOV CX,2 + 250 00B0 DOFIX: + 251 00B0 E8 0126 R CALL FIX + 252 00B3 59 POP CX + 253 00B4 CB RET + 254 + 255 00B5 $FID: ;Double precision + 256 00B5 87 F3 XCHG SI,BX + 257 00B7 E8 0183 R CALL PUTDAC + 258 00BA 87 F3 XCHG SI,BX + 259 00BC 51 PUSH CX + 260 00BD B9 0006 MOV CX,6 + 261 00C0 E8 0126 R CALL FIX + 262 00C3 RETC: + 263 00C3 59 POP CX + 264 00C4 CB RET + 265 + 266 + 267 ;*** $INT - Floor function + 268 ; + 269 ; Inputs: + 270 ; BX = Address of argument + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-6 + + + + 271 ; Function: + 272 ; Compute largest integer <= argument. Thus -12.5 -> -13. + 273 ; $INT is for single precision, $IND is for double precision. + 274 ; Outputs: + 275 ; Result in $FAC, same type as argument (SP or DP). + 276 ; Registers: + 277 ; Only F affected. + 278 + 279 00C5 $INT: + 280 00C5 87 F3 XCHG SI,BX + 281 00C7 E8 0178 R CALL PUTAC + 282 00CA 87 F3 XCHG SI,BX + 283 00CC 51 PUSH CX + 284 00CD B9 0002 MOV CX,2 + 285 00D0 INT: + 286 00D0 80 3E 0000 E 00 CMP [$FAC], 0 ;Is FAC zero? + 287 00D5 74 EC JZ RETC ;If so, done already + 288 00D7 F6 06 FFFF E 80 TEST [$FAC-1],80H ;Check sign bit + 289 00DC 74 D2 JZ DOFIX ;If positive, just do FIX + 290 00DE 51 PUSH CX + 291 00DF E8 015D R CALL NEGATE ;Use two's complement + 292 00E2 59 POP CX + 293 00E3 51 PUSH CX + 294 00E4 E8 0126 R CALL FIX + 295 00E7 59 POP CX + 296 00E8 80 3E 0000 E 00 CMP [$FAC],0 ;Was magnitude less than 1? + 297 00ED 74 14 JZ MINUSONE + 298 00EF E8 015D R CALL NEGATE ;Fix it back + 299 00F2 59 POP CX + 300 00F3 75 23 JNZ RET1 ;Did we overflow? + 301 00F5 C6 06 FFFF E 80 MOV [$FAC-1],80H ;Yes - set sign bit + 302 00FA FE 06 0000 E INC [$FAC] ;Bump exponent + 303 00FE 75 18 JNZ RET1 + 304 0100 E9 0000 E JMP $OVFL + 305 + 306 0103 MINUSONE: + 307 0103 33 C9 XOR CX,CX + 308 0105 89 0E 0000 E MOV [$DAC],CX ;Force -1 as result + 309 0109 89 0E 0002 E MOV [$DAC+2],CX + 310 010D 89 0E 0000 E MOV [$AC],CX + 311 0111 C7 06 0002 E 8180 MOV [$AC+2],8180H + 312 0117 59 POP CX + 313 0118 CB RET1: RET + 314 + 315 + 316 0119 $IND: + 317 0119 87 F3 XCHG SI,BX + 318 011B E8 0183 R CALL PUTDAC + 319 011E 87 F3 XCHG SI,BX + 320 0120 51 PUSH CX + 321 0121 B9 0006 MOV CX,6 + 322 0124 EB AA JMP INT + 323 + 324 0126 NUMFCN ENDP + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-7 + + + + 325 + 326 0126 FIX: + 327 0126 50 PUSH AX + 328 0127 53 PUSH BX + 329 0128 57 PUSH DI + 330 0129 A0 0000 E MOV AL,[$FAC] ;Get exponent + 331 012C 2C 80 SUB AL,80H + 332 012E 76 26 JBE ZERO + 333 0130 BF FFFF E MOV DI,OFFSET DC:$FAC-1 ;Point to high mantissa byte + 334 0133 8A D8 MOV BL,AL + 335 0135 D0 E8 SHR AL,1 + 336 0137 D0 E8 SHR AL,1 + 337 0139 D0 E8 SHR AL,1 + 338 013B 98 CBW ;Number of mantissa bytes in integer + 339 013C 2B F8 SUB DI,AX + 340 013E 2B C8 SUB CX,AX ;Advance over full bytes + 341 0140 72 10 JB POPRET + 342 0142 93 XCHG BX,AX + 343 0143 24 07 AND AL,7 ;Bits in last byte + 344 0145 BB 0000 R MOV BX,OFFSET DC:FIXTAB + 345 0148 D7 XLAT + 346 0149 20 05 AND [DI],AL ;Reset fraction bits + 347 014B 32 C0 XOR AL,AL + 348 014D 4F DEC DI + 349 014E FD STD ;Set direction DOWN + 350 014F F3/ AA REP STOSB ;Zero trailing bytes + 351 0151 FC CLD ;Restore direction + 352 0152 POPRET: + 353 0152 5F POP DI + 354 0153 5B POP BX + 355 0154 58 POP AX + 356 0155 C3 RET + 357 + 358 0156 ZERO: + 359 0156 C6 06 0000 E 00 MOV [$FAC],0 + 360 015B EB F5 JMP POPRET + 361 + 362 015D NEGATE: + 363 015D 56 PUSH SI + 364 015E BE FFFE E MOV SI,OFFSET DC:$FAC-2 + 365 0161 D1 E9 SHR CX,1 ;Do it by words + 366 0163 51 PUSH CX + 367 0164 NOTLP: + 368 0164 F7 14 NOT WORD PTR [SI] + 369 0166 4E DEC SI + 370 0167 4E DEC SI + 371 0168 E2 FA LOOP NOTLP + 372 016A 59 POP CX + 373 016B F6 5C 01 NEG BYTE PTR [SI+1] + 374 016E 75 06 JNZ NO_INC + 375 0170 INCLP: + 376 0170 46 INC SI + 377 0171 46 INC SI + 378 0172 FF 04 INC WORD PTR [SI] + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Page 1-8 + + + + 379 0174 E1 FA LOOPZ INCLP + 380 0176 NO_INC: + 381 0176 5E POP SI + 382 0177 C3 RET + 383 + 384 0178 PUTAC: + 385 0178 57 PUSH DI + 386 0179 BF 0000 E MOV DI,OFFSET DC:$AC + 387 017C A5 MOVSW + 388 017D A5 MOVSW + 389 017E 5F POP DI + 390 017F 83 EE 04 SUB SI,4 + 391 0182 C3 RET + 392 + 393 0183 PUTDAC: + 394 0183 57 PUSH DI + 395 0184 BF 0000 E MOV DI,OFFSET DC:$DAC + 396 0187 A5 MOVSW + 397 0188 A5 MOVSW + 398 0189 A5 MOVSW + 399 018A A5 MOVSW + 400 018B 5F POP DI + 401 018C 83 EE 08 SUB SI,8 + 402 018F C3 RET + 403 + 404 0190 CODE ENDS + 405 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0190 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0008 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0002 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +DOFIX. . . . . . . . . . . . . . L NEAR 00B0 CODE +FC0. . . . . . . . . . . . . . . L NEAR 003E CODE +FIX. . . . . . . . . . . . . . . L NEAR 0126 CODE +FIXTAB . . . . . . . . . . . . . L BYTE 0000 CONST +INCLP. . . . . . . . . . . . . . L NEAR 0170 CODE +INT. . . . . . . . . . . . . . . L NEAR 00D0 CODE +MINUSONE . . . . . . . . . . . . L NEAR 0103 CODE +NEGATE . . . . . . . . . . . . . L NEAR 015D CODE +NOTLP. . . . . . . . . . . . . . L NEAR 0164 CODE +NO_INC . . . . . . . . . . . . . L NEAR 0176 CODE +NUMFCN . . . . . . . . . . . . . F PROC 0000 CODE Length =0126 +POPRET . . . . . . . . . . . . . L NEAR 0152 CODE +PRET . . . . . . . . . . . . . . L NEAR 0044 CODE +PUTAC. . . . . . . . . . . . . . L NEAR 0178 CODE +PUTDAC . . . . . . . . . . . . . L NEAR 0183 CODE +RET. . . . . . . . . . . . . . . L NEAR 0070 CODE +RET1 . . . . . . . . . . . . . . L NEAR 0118 CODE +RETC . . . . . . . . . . . . . . L NEAR 00C3 CODE +SAVSGN . . . . . . . . . . . . . L NEAR 0024 CODE +SGN. . . . . . . . . . . . . . . L NEAR 001C CODE +SISAVE . . . . . . . . . . . . . L WORD 0000 DATA +ZERO . . . . . . . . . . . . . . L NEAR 0156 CODE +$ABSA. . . . . . . . . . . . . . L NEAR 0071 CODE Global +$ABSB. . . . . . . . . . . . . . L NEAR 007A CODE Global +$ABSC. . . . . . . . . . . . . . L NEAR 0074 CODE Global +$ABSD. . . . . . . . . . . . . . L NEAR 007D CODE Global +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$CNZA. . . . . . . . . . . . . . L NEAR 0052 CODE Global +$CNZB. . . . . . . . . . . . . . L NEAR 005C CODE Global +$CNZC. . . . . . . . . . . . . . L NEAR 0066 CODE Global +$CNZD. . . . . . . . . . . . . . L NEAR 0066 CODE Global +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FC0A. . . . . . . . . . . . . . L NEAR 003A CODE Global +$FC0B. . . . . . . . . . . . . . L NEAR 0046 CODE Global +$FC0C. . . . . . . . . . . . . . L NEAR 004C CODE Global +$FC0D. . . . . . . . . . . . . . L NEAR 004C CODE Global +$FID . . . . . . . . . . . . . . L NEAR 00B5 CODE Global +$FIX . . . . . . . . . . . . . . L NEAR 00A5 CODE Global +$FSHA. . . . . . . . . . . . . . L NEAR 0083 CODE Global +$FSHB. . . . . . . . . . . . . . L NEAR 00A0 CODE Global + + +NUMFCN - Arithmetic functions Macro-86 %1(12) 1:6:14 13-Nov-81 Symbols-2 + + + +$FSHC. . . . . . . . . . . . . . L NEAR 0086 CODE Global +$FSHD. . . . . . . . . . . . . . L NEAR 0086 CODE Global +$FUMA. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FUMB. . . . . . . . . . . . . . L NEAR 0009 CODE Global +$FUMC. . . . . . . . . . . . . . L NEAR 0003 CODE Global +$FUMD. . . . . . . . . . . . . . L NEAR 000C CODE Global +$IND . . . . . . . . . . . . . . L NEAR 0119 CODE Global +$INT . . . . . . . . . . . . . . L NEAR 00C5 CODE Global +$OVFL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SGNA. . . . . . . . . . . . . . L NEAR 0012 CODE Global +$SGNB. . . . . . . . . . . . . . L NEAR 0034 CODE Global +$SGNC. . . . . . . . . . . . . . L NEAR 0018 CODE Global +$SGND. . . . . . . . . . . . . . L NEAR 0018 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/NUMFCN.ASM b/3_source_code/BASLIB-86/NUMFCN.ASM new file mode 100644 index 0000000..02d824c --- /dev/null +++ b/3_source_code/BASLIB-86/NUMFCN.ASM @@ -0,0 +1,404 @@ + TITLE NUMFCN - Arithmetic functions + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $FAC:BYTE, $AC:WORD, $DAC:WORD + +SISAVE DW ? + +DATA ENDS + + +CONST SEGMENT WORD PUBLIC 'CONST' + +FIXTAB DB 0,80H,0C0H,0E0H,0F0H,0F8H,0FCH,0FEH + +CONST ENDS + +DC GROUP CONST,DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FUMA,$FUMB,$FUMC,$FUMD,$SGNA,$SGNB,$SGNC,$SGND + PUBLIC $FC0A,$FC0B,$FC0C,$FC0D,$CNZA,$CNZB,$CNZC,$CNZD + PUBLIC $FIX, $FID, $INT, $IND, $ABSA,$ABSB,$ABSC,$ABSD + PUBLIC $FSHA,$FSHB,$FSHC,$FSHD + + EXTRN $OVFL:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +NUMFCN PROC FAR ;Set up long returns + + +;*** $FUM - Floating unary minus +; +; Inputs: +; SI = Address of argument ($FUMA/$FUMB) +; $FAC has argument ($FUMC/$FUMD) +; Function: +; Invert sign +; Outputs: +; Result in FAC. +; Registers: +; Only F affected. + +$FUMA: ;Single precision + CALL PUTAC +$FUMC: + XOR [$FAC-1],80H + RET + +$FUMB: ;Double precision + CALL PUTDAC +$FUMD: + XOR [$FAC-1],80H + RET + + +;*** $SIGN - SGN function +; +; Inputs: +; SI = Address of argument ($SGNA/$SGNB) +; FAC has argument ($SGNC/$SGND) +; Function: +; Return 1 if argument positive +; Return 0 if argument zero +; Return -1 if argument negative +; Outputs: +; FAC has result, same type as argument +; Registers: +; Only F affected. + +$SGNA: ;Single precision + PUSH AX + MOV AX,[SI+2] ;Get sign and exponent + JMP SHORT SGN + +$SGNC: +$SGND: + PUSH AX + MOV AX,[$AC+2] +SGN: + OR AH,AH ;Check exponent for zero + JZ SAVSGN + MOV AH,81H ;Set exponent for +1 or -1 + AND AL,80H ;Reduce to sign bit +SAVSGN: + MOV [$AC+2],AX + XOR AX,AX + MOV [$DAC],AX + MOV [$DAC+2],AX + MOV [$AC],AX + POP AX + RET + +$SGNB: ;Double precision + PUSH AX + MOV AX,[SI+6] ;Get sign and exponent + JMP SGN + + +;*** $FC0 - Floating compare for zero +; +; Inputs: +; SI = Address of argument ($FC0A/$FC0B) +; $FAC has argument ($FC0C/$FC0D) +; Function: +; Compare the floating point number against zero, setting ZF and CF. +; Outputs: +; Positive: ZF=0, CF=0, Zero: ZF=1, CF=0; Negative: ZF=0, CF=1. +; Registers: +; Only F affected. + +$FC0A: ;Single precision + PUSH AX + MOV AX,[SI+2] +FC0: + OR AH,AH ;Exponent zero? + JZ PRET + RCL AL,1 ;Rotate sign into carry +PRET: + POP AX + RET + +$FC0B: ;Double precision + PUSH AX + MOV AX,[SI+6] + JMP FC0 + +$FC0C: +$FC0D: + PUSH AX + MOV AX,[$AC+2] + JMP FC0 + + +;*** $CNZ - Compare for non-zero +; +; Inputs: +; SI = Address of argument ($CNZA/$CNZB) +; $FAC has argument ($CNZC/$CNZD) +; Function: +; Return integer 0 if argument 0, integer -1 otherwise +; Outputs: +; Result in BX +; Registers: +; Only BX affected. + +$CNZA: ;Single precision + XOR BX,BX + CMP BYTE PTR[SI+3],0 + JZ RET + DEC BX + RET + +$CNZB: ;Double precision + XOR BX,BX + CMP BYTE PTR[SI+7],0 + JZ RET + DEC BX + RET + +$CNZC: +$CNZD: + XOR BX,BX + CMP [$FAC],0 + JZ RET + DEC BX +RET: RET + + +;*** $ABS - Absolute value function +; +; Inputs: +; SI = Address of argument ($ABSA/$ABSC) +; FAC = argument ($ABSB/$ABSD) +; Outputs: +; Absolute value in FAC +; Registers: +; Only F affected. + +$ABSA: ;Single precision + CALL PUTAC +$ABSC: AND [$FAC-1],7FH ;Force sign positive + RET + +$ABSB: ;Double precision + CALL PUTDAC +$ABSD: AND [$FAC-1],7FH + RET + + +;*** $FSH - Floating shift +; +; Inputs: +; SI = Address of argument ($FSHA/$FSHB) +; $FAC has argument ($FSHC/$FSHD) +; Long return address on top of stack pointer to a byte. +; Function: +; Add byte to exponent of floating point number. +; Outputs: +; Result in FAC. +; Registers: +; Only F affected. + +$FSHA: ;Single precision + CALL PUTAC +$FSHC: +$FSHD: + MOV [SISAVE],SI + POP SI + POP DS ;Get pointer to power + PUSH AX + LODSB + ADD [$FAC],AL ;Add byte to exponent + POP AX + PUSH DS + PUSH SI + PUSH ES + POP DS ;Restore DS + MOV SI,[SISAVE] + JNC RET + JMP $OVFL + +$FSHB: + CALL PUTDAC + JMP $FSHD + + +;*** $FIX - Get integer part of argument, chopped toward zero +; +; Inputs: +; BX = Address of argument +; Function: +; Compute integer part, chopped toward zero (-12.5 -> -12). +; $FIX is for single precision, $FID is for double precision. +; Outputs: +; Result in $FAC, same type as argument (SP or DP) +; Registers: +; Only F affected. + +$FIX: ;Single precision + XCHG SI,BX + CALL PUTAC + XCHG SI,BX + PUSH CX + MOV CX,2 +DOFIX: + CALL FIX + POP CX + RET + +$FID: ;Double precision + XCHG SI,BX + CALL PUTDAC + XCHG SI,BX + PUSH CX + MOV CX,6 + CALL FIX +RETC: + POP CX + RET + + +;*** $INT - Floor function +; +; Inputs: +; BX = Address of argument +; Function: +; Compute largest integer <= argument. Thus -12.5 -> -13. +; $INT is for single precision, $IND is for double precision. +; Outputs: +; Result in $FAC, same type as argument (SP or DP). +; Registers: +; Only F affected. + +$INT: + XCHG SI,BX + CALL PUTAC + XCHG SI,BX + PUSH CX + MOV CX,2 +INT: + CMP [$FAC], 0 ;Is FAC zero? + JZ RETC ;If so, done already + TEST [$FAC-1],80H ;Check sign bit + JZ DOFIX ;If positive, just do FIX + PUSH CX + CALL NEGATE ;Use two's complement + POP CX + PUSH CX + CALL FIX + POP CX + CMP [$FAC],0 ;Was magnitude less than 1? + JZ MINUSONE + CALL NEGATE ;Fix it back + POP CX + JNZ RET1 ;Did we overflow? + MOV [$FAC-1],80H ;Yes - set sign bit + INC [$FAC] ;Bump exponent + JNZ RET1 + JMP $OVFL + +MINUSONE: + XOR CX,CX + MOV [$DAC],CX ;Force -1 as result + MOV [$DAC+2],CX + MOV [$AC],CX + MOV [$AC+2],8180H + POP CX +RET1: RET + + +$IND: + XCHG SI,BX + CALL PUTDAC + XCHG SI,BX + PUSH CX + MOV CX,6 + JMP INT + +NUMFCN ENDP + +FIX: + PUSH AX + PUSH BX + PUSH DI + MOV AL,[$FAC] ;Get exponent + SUB AL,80H + JBE ZERO + MOV DI,OFFSET DC:$FAC-1 ;Point to high mantissa byte + MOV BL,AL + SHR AL,1 + SHR AL,1 + SHR AL,1 + CBW ;Number of mantissa bytes in integer + SUB DI,AX + SUB CX,AX ;Advance over full bytes + JB POPRET + XCHG BX,AX + AND AL,7 ;Bits in last byte + MOV BX,OFFSET DC:FIXTAB + XLAT + AND [DI],AL ;Reset fraction bits + XOR AL,AL + DEC DI + STD ;Set direction DOWN + REP STOSB ;Zero trailing bytes + CLD ;Restore direction +POPRET: + POP DI + POP BX + POP AX + RET + +ZERO: + MOV [$FAC],0 + JMP POPRET + +NEGATE: + PUSH SI + MOV SI,OFFSET DC:$FAC-2 + SHR CX,1 ;Do it by words + PUSH CX +NOTLP: + NOT WORD PTR [SI] + DEC SI + DEC SI + LOOP NOTLP + POP CX + NEG BYTE PTR [SI+1] + JNZ NO_INC +INCLP: + INC SI + INC SI + INC WORD PTR [SI] + LOOPZ INCLP +NO_INC: + POP SI + RET + +PUTAC: + PUSH DI + MOV DI,OFFSET DC:$AC + MOVSW + MOVSW + POP DI + SUB SI,4 + RET + +PUTDAC: + PUSH DI + MOV DI,OFFSET DC:$DAC + MOVSW + MOVSW + MOVSW + MOVSW + POP DI + SUB SI,8 + RET + +CODE ENDS + END From 501f1be5869d7b9785a7499d926828644f099fec Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Fri, 24 Jul 2026 15:40:19 -0700 Subject: [PATCH 44/53] Transcription of Bundle 9 - OUT.ASM Code and Listing NOTE there are several extra records in the symbol table that are not in the source code for the listing. This results in "Symbol not defined" error at lines 40, 42, 47, 48 and "Must be declared in pass 1" error at line 60. This is due to assembler directives to mask the includes. Other include files already added to this PR can be added to the source file to remove the errors. Specifically DEVDEF.INC and SYSTEM.INC. --- 2_printed_files/bundle_09/OUT.ASM | 479 ++++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/OUT.ASM | 199 +++++++++++++ 2 files changed, 678 insertions(+) create mode 100644 2_printed_files/bundle_09/OUT.ASM create mode 100644 3_source_code/BASLIB-86/OUT.ASM diff --git a/2_printed_files/bundle_09/OUT.ASM b/2_printed_files/bundle_09/OUT.ASM new file mode 100644 index 0000000..f0d6201 --- /dev/null +++ b/2_printed_files/bundle_09/OUT.ASM @@ -0,0 +1,479 @@ +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Page 1-1 + + + + 1 TITLE OUT - Output utilities + 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Page 1-2 + + + + 3 .list + 4 + 5 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 6 + 7 EXTRN $PTRFIL:WORD,$$WRFL:BYTE + 8 + 9 0000 DATA ENDS + 10 + 11 DC GROUP DATA + 12 + 13 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 14 + 15 PUBLIC $$WCLF,$$THB,$TYTX,$TYPTX,$$TCR,$$WCHT + 16 PUBLIC $TYPSTR,$TYPCNT,$OUTCNT + 17 + 18 EXTRN $$WCH:NEAR + 19 EXTRN $TTYOT:NEAR + 20 + 21 ASSUME CS:CODE, DS:DC, ES:DC + 22 + 23 = 000D CR EQU 13 + 24 = 000A LF EQU 10 + 25 + 26 = 0002 CRLF_LEN= 2 ;Length of CR/LF sequence on disk + 27 + 28 + 29 ;** $$WCLF - Write new line + 30 ; + 31 ; USES F + 32 + 33 0000 50 $$WCLF: PUSH AX ;Save (AX) + 34 0001 53 PUSH BX + 35 0002 56 PUSH SI + 36 + 37 0003 8B 36 0000 E MOV SI,[$PTRFIL] + 38 0007 0B F6 OR SI,SI ;Check for standard output + 39 0009 74 27 JE wcspec ; Yes - do special CR/LF + 40 000B F6 44 2E 80 TEST [SI].FD_DEVICE,80h ;Test for special device + 41 000F 75 21 JNZ wcspec ; Yes - do special CR/LF + 42 0011 80 3C 04 CMP [SI].FD_MODE,MD_RND ;Check for random + 43 0014 75 1C JNE wcdisk ; No - do disk CR/LF + 44 0016 80 3E 0000 E 00 CMP [$$WRFL],0 ;Test for WRITE statement + 45 001B 74 15 JE wcdisk ; No - just do disk CR/LF + 46 + 47 001D 8B 9C 00B3 MOV BX,[SI].FR_VRECL ;Get field length + 48 0021 2B 9C 00BA SUB BX,[SI].FR_OUTPOS ; Subtract off bytes already written + 49 0025 83 EB 02 SUB BX,CRLF_LEN ; and two more for CR/LF + 50 0028 B0 20 MOV AL,' ' ;Write (BX) spaces + 51 + 52 ; This is tricky because DISK_SOUT will give FOV error if + 53 ; (BX) is negative. + 54 + 55 002A 74 06 wspc: JZ wcdisk ;(BX) = 0 - done + 56 002C E8 0000 E CALL $$WCH ;Write space + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Page 1-3 + + + + 57 002F 4B DEC BX ;Decrement (BX) + 58 0030 EB F8 JMP wspc ;Keep on looping until (BX) = 0 + 59 + 60 if _IBM_ + 61 wcdisk: MOV AL,CR + 62 CALL $$WCH ;Output CR + 63 MOV AL,LF + 64 CALL $$WCH ;Output LF + 65 JMP SHORT wclxt + 66 + 67 wcspec: MOV AL,CR ;Output CR only + 68 CALL $$WCH + 69 else + 70 0032 wcdisk: + 71 0032 B0 0D wcspec: MOV AL,CR ;Output CR/LF + 72 0034 E8 0000 E CALL $$WCH + 73 0037 B0 0A MOV AL,LF + 74 0039 E8 0000 E CALL $$WCH + 75 endif + 76 + 77 003C 5E wclxt: POP SI + 78 003D 5B POP BX + 79 003E 58 POP AX + 80 003F C3 RET + 81 + 82 + 83 ;*** $$TCR - Type CR/LF on console + 84 ; + 85 ; Uses F + 86 + 87 0040 $$TCR: + 88 0040 50 PUSH AX + 89 0041 FF 36 0000 E PUSH [$PTRFIL] + 90 0045 C7 06 0000 E 0000 MOV [$PTRFIL],0 + 91 004B E8 0000 R CALL $$WCLF + 92 004E 8F 06 0000 E POP [$PTRFIL] + 93 0052 58 POP AX + 94 0053 C3 RET + 95 + 96 + 97 0054 $$WCHT: + 98 0054 FF 36 0000 E PUSH [$PTRFIL] ;Save current output pointer + 99 0058 C7 06 0000 E 0000 MOV [$PTRFIL],0 ;Set pointer to console output + 100 005E E8 0000 E CALL $$WCH + 101 0061 8F 06 0000 E POP [$PTRFIL] ;Restore pointer + 102 0065 C3 RET: RET + 103 + 104 + 105 + 106 ;*** $$THB - Type hex byte + 107 ; + 108 ; Inputs: + 109 ; AL = Byte to output in hex + 110 ; Outputs: + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Page 1-4 + + + + 111 ; None. + 112 ; Registers: + 113 ; Only AL and F affected. + 114 + 115 0066 $$THB: + 116 0066 50 PUSH AX + 117 0067 D0 E8 SHR AL,1 + 118 0069 D0 E8 SHR AL,1 + 119 006B D0 E8 SHR AL,1 + 120 006D D0 E8 SHR AL,1 + 121 006F E8 0073 R CALL DIGIT + 122 0072 58 POP AX + 123 0073 DIGIT: + 124 0073 24 0F AND AL,0FH + 125 0075 24 90 AND AL,90H + 126 0077 27 DAA + 127 0078 14 40 ADC AL,40H + 128 007A 27 DAA + 129 007B EB D7 JMP $$WCHT + 130 + 131 + 132 ;*** $TYTX - Type text + 133 ; + 134 ; Inputs: + 135 ; SI has pointer to text string in code segment + 136 ; Function: + 137 ; Print string with bit 7 set in last character + 138 ; Outputs: + 139 ; SI points past end of text. + 140 ; Registers: + 141 ; SI, AX and F affected. + 142 + 143 007D $TYTX: + 144 007D 2E: AC LODS BYTE PTR CS:[SI] + 145 007F 50 PUSH AX + 146 0080 24 7F AND AL,7FH + 147 0082 E8 0054 R CALL $$WCHT + 148 0085 58 POP AX + 149 0086 A8 80 TEST AL,80H + 150 0088 74 F3 JZ $TYTX + 151 008A C3 RET + 152 + 153 + 154 + 155 ;*** $TYPTX - Print string pointed to by top of stack + 156 ; + 157 ; Inputs: + 158 ; Top of stack has address in code segment of text string terminated + 159 ; with bit 7 set. + 160 ; Function: + 161 ; Print the string. + 162 ; Outputs: + 163 ; None. Returns to first location after the string. + 164 ; Registers: + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Page 1-5 + + + + 165 ; Only AX and F affected. + 166 + 167 008B $TYPTX: + 168 008B 58 POP AX + 169 008C 56 PUSH SI + 170 008D 8B F0 MOV SI,AX + 171 008F E8 007D R CALL $TYTX + 172 0092 8B C6 MOV AX,SI + 173 0094 5E POP SI + 174 0095 FF E0 JMP AX + 175 + 176 + 177 + 178 ;*** $TYPSTR - Type string given descriptor + 179 ; + 180 ; Inputs: + 181 ; BX = Address of string descriptor + 182 ; Outputs: + 183 ; None. + 184 ; Registers: + 185 ; CX,SI,AX,F destroyed. + 186 + 187 0097 $TYPSTR: + 188 0097 8B 0F MOV CX,[BX] + 189 0099 $TYPCNT: + 190 0099 E3 CA JCXZ RET + 191 009B 8B 77 02 MOV SI,[BX+2] + 192 009E $OUTCNT: + 193 009E AC LODSB + 194 009F E8 0000 E CALL $$WCH + 195 00A2 E2 FA LOOP $OUTCNT + 196 00A4 C3 RET + 197 + 198 00A5 CODE ENDS + 199 END + + + + + + + + + + + + + + + + + + + + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00A5 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +CR . . . . . . . . . . . . . . . Number 000D +CRLF_LEN . . . . . . . . . . . . Number 0002 +DIGIT. . . . . . . . . . . . . . L NEAR 0073 CODE +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Symbols-2 + + + +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +EOFCHR . . . . . . . . . . . . . Number 001A +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +LF . . . . . . . . . . . . . . . Number 000A +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +REC_LENGTH . . . . . . . . . . . Number 0080 +RET. . . . . . . . . . . . . . . L NEAR 0065 CODE +WCDISK . . . . . . . . . . . . . L NEAR 0032 CODE +WCLXT. . . . . . . . . . . . . . L NEAR 003C CODE +WCSPEC . . . . . . . . . . . . . L NEAR 0032 CODE +WSPC . . . . . . . . . . . . . . L NEAR 002A CODE +$$TCR. . . . . . . . . . . . . . L NEAR 0040 CODE Global +$$THB. . . . . . . . . . . . . . L NEAR 0066 CODE Global +$$WCH. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WCHT . . . . . . . . . . . . . L NEAR 0054 CODE Global +$$WCLF . . . . . . . . . . . . . L NEAR 0000 CODE Global +$$WRFL . . . . . . . . . . . . . V BYTE 0000 DATA External +$OUTCNT. . . . . . . . . . . . . L NEAR 009E CODE Global +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +$TTYOT . . . . . . . . . . . . . L NEAR 0000 CODE External +$TYPCNT. . . . . . . . . . . . . L NEAR 0099 CODE Global +$TYPSTR. . . . . . . . . . . . . L NEAR 0097 CODE Global +$TYPTX . . . . . . . . . . . . . L NEAR 008B CODE Global +$TYTX. . . . . . . . . . . . . . L NEAR 007D CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + + +OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Symbols-3 + + + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/OUT.ASM b/3_source_code/BASLIB-86/OUT.ASM new file mode 100644 index 0000000..5e1c057 --- /dev/null +++ b/3_source_code/BASLIB-86/OUT.ASM @@ -0,0 +1,199 @@ + TITLE OUT - Output utilities + +.list + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $PTRFIL:WORD,$$WRFL:BYTE + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $$WCLF,$$THB,$TYTX,$TYPTX,$$TCR,$$WCHT + PUBLIC $TYPSTR,$TYPCNT,$OUTCNT + + EXTRN $$WCH:NEAR + EXTRN $TTYOT:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +CR EQU 13 +LF EQU 10 + +CRLF_LEN= 2 ;Length of CR/LF sequence on disk + + +;** $$WCLF - Write new line +; +; USES F + +$$WCLF: PUSH AX ;Save (AX) + PUSH BX + PUSH SI + + MOV SI,[$PTRFIL] + OR SI,SI ;Check for standard output + JE wcspec ; Yes - do special CR/LF + TEST [SI].FD_DEVICE,80h ;Test for special device + JNZ wcspec ; Yes - do special CR/LF + CMP [SI].FD_MODE,MD_RND ;Check for random + JNE wcdisk ; No - do disk CR/LF + CMP [$$WRFL],0 ;Test for WRITE statement + JE wcdisk ; No - just do disk CR/LF + + MOV BX,[SI].FR_VRECL ;Get field length + SUB BX,[SI].FR_OUTPOS ; Subtract off bytes already written + SUB BX,CRLF_LEN ; and two more for CR/LF + MOV AL,' ' ;Write (BX) spaces + +; This is tricky because DISK_SOUT will give FOV error if +; (BX) is negative. + +wspc: JZ wcdisk ;(BX) = 0 - done + CALL $$WCH ;Write space + DEC BX ;Decrement (BX) + JMP wspc ;Keep on looping until (BX) = 0 + +if _IBM_ +wcdisk: MOV AL,CR + CALL $$WCH ;Output CR + MOV AL,LF + CALL $$WCH ;Output LF + JMP SHORT wclxt + +wcspec: MOV AL,CR ;Output CR only + CALL $$WCH +else +wcdisk: +wcspec: MOV AL,CR ;Output CR/LF + CALL $$WCH + MOV AL,LF + CALL $$WCH +endif + +wclxt: POP SI + POP BX + POP AX + RET + + +;*** $$TCR - Type CR/LF on console +; +; Uses F + +$$TCR: + PUSH AX + PUSH [$PTRFIL] + MOV [$PTRFIL],0 + CALL $$WCLF + POP [$PTRFIL] + POP AX + RET + + +$$WCHT: + PUSH [$PTRFIL] ;Save current output pointer + MOV [$PTRFIL],0 ;Set pointer to console output + CALL $$WCH + POP [$PTRFIL] ;Restore pointer +RET: RET + + + +;*** $$THB - Type hex byte +; +; Inputs: +; AL = Byte to output in hex +; Outputs: +; None. +; Registers: +; Only AL and F affected. + +$$THB: + PUSH AX + SHR AL,1 + SHR AL,1 + SHR AL,1 + SHR AL,1 + CALL DIGIT + POP AX +DIGIT: + AND AL,0FH + AND AL,90H + DAA + ADC AL,40H + DAA + JMP $$WCHT + + +;*** $TYTX - Type text +; +; Inputs: +; SI has pointer to text string in code segment +; Function: +; Print string with bit 7 set in last character +; Outputs: +; SI points past end of text. +; Registers: +; SI, AX and F affected. + +$TYTX: + LODS BYTE PTR CS:[SI] + PUSH AX + AND AL,7FH + CALL $$WCHT + POP AX + TEST AL,80H + JZ $TYTX + RET + + + +;*** $TYPTX - Print string pointed to by top of stack +; +; Inputs: +; Top of stack has address in code segment of text string terminated +; with bit 7 set. +; Function: +; Print the string. +; Outputs: +; None. Returns to first location after the string. +; Registers: +; Only AX and F affected. + +$TYPTX: + POP AX + PUSH SI + MOV SI,AX + CALL $TYTX + MOV AX,SI + POP SI + JMP AX + + + +;*** $TYPSTR - Type string given descriptor +; +; Inputs: +; BX = Address of string descriptor +; Outputs: +; None. +; Registers: +; CX,SI,AX,F destroyed. + +$TYPSTR: + MOV CX,[BX] +$TYPCNT: + JCXZ RET + MOV SI,[BX+2] +$OUTCNT: + LODSB + CALL $$WCH + LOOP $OUTCNT + RET + +CODE ENDS + END From 3b06a1a4da95f7a8e53d189f84f0ca1d1d6beb76 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 4 Aug 2026 16:11:58 -0700 Subject: [PATCH 45/53] Transcription of Bundle 9 - POLY.ASM Code and Listing --- 2_printed_files/bundle_09/POLY.ASM | 240 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/POLY.ASM | 152 ++++++++++++++++++ 2 files changed, 392 insertions(+) create mode 100644 2_printed_files/bundle_09/POLY.ASM create mode 100644 3_source_code/BASLIB-86/POLY.ASM diff --git a/2_printed_files/bundle_09/POLY.ASM b/2_printed_files/bundle_09/POLY.ASM new file mode 100644 index 0000000..87086b8 --- /dev/null +++ b/2_printed_files/bundle_09/POLY.ASM @@ -0,0 +1,240 @@ +POLY - Polynomial evaluator for transcendental functions Macro-86 %1(12) 1:6:40 13-Nov-81 Page 1-1 + + + + 1 TITLE POLY - Polynomial evaluator for transcendental functions + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $AC:WORD, $DAC:WORD, $ARG:WORD + 6 + 7 0000 DATA ENDS + 8 + 9 + 10 DC GROUP DATA + 11 + 12 + 13 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 14 + 15 PUBLIC $SPOLY, $SPOLY2, $SPOLYX, $DPOLY, $DPOLY2, $DPOLYX + 16 + 17 EXTRN $SMUL:NEAR, $SADD:NEAR, $DMUL:NEAR, $DADD:NEAR + 18 + 19 ASSUME CS:CODE, DS:DC, ES:DC + 20 + 21 + 22 ;*** $SPOLY, $SPOLY2, & $SPOLYX - Evaluate SP polynomial + 23 ; + 24 ; Inputs: + 25 ; BX = Address of list of coefficients. First byte in list is nmber of + 26 ; coefficients, followed by the constants ordered from highest + 27 ; power to lowest. + 28 ; FAC = argument. + 29 ; Function: + 30 ; Evaluate polynomial by Horner's method + 31 ; Outputs: + 32 ; Result in FAC. + 33 ; Registers: + 34 ; ALL destroyed. + 35 + 36 0000 $SPOLY2: + 37 ;Compute polynomial on square of argument + 38 0000 53 PUSH BX + 39 0001 BE 0000 E MOV SI,OFFSET DC:$AC + 40 0004 8B FE MOV DI,SI + 41 0006 E8 0000 E CALL $SMUL ;Square the argument + 42 0009 5B POP BX + 43 000A $SPOLY: + 44 000A BE 0000 E MOV SI,OFFSET DC:$AC + 45 000D BF 0000 E MOV DI,OFFSET DC:$ARG ;Local stroage for argument + 46 0010 A5 MOVSW + 47 0011 A5 MOVSW ;Save argument + 48 0012 8B F3 MOV SI,BX ;Point to coefficient table + 49 0014 AD LODSW ;Number of coefficients + 50 0015 91 XCHG AX,CX ;Count in CX + 51 0016 BF 0000 E MOV DI,OFFSET DC:$AC + 52 0019 A5 MOVSW ;Move first coefficient into FAC + 53 001A A5 MOVSW + 54 001B SPOLYLOOP: + + +POLY - Polynomial evaluator for transcendental functions Macro-86 %1(12) 1:6:40 13-Nov-81 Page 1-2 + + + + 55 001B 51 PUSH CX + 56 001C 56 PUSH SI + 57 001D BE 0000 E MOV SI,OFFSET DC:$AC + 58 0020 BF 0000 E MOV DI,OFFSET DC:$ARG + 59 0023 E8 0000 E CALL $SMUL ;Multiply by argument + 60 0026 5E POP SI ;Recover pointer to next coefficient + 61 0027 56 PUSH SI + 62 0028 BF 0000 E MOV DI,OFFSET DC:$AC + 63 002B E8 0000 E CALL $SADD ;Add coefficient + 64 002E 5E POP SI + 65 002F 59 POP CX + 66 0030 83 C6 04 ADD SI,4 ;Bump to next coefficient + 67 0033 E2 E6 LOOP SPOLYLOOP + 68 0035 C3 RET + 69 + 70 0036 $SPOLYX: + 71 ;Same as $SPOLY2, but multiplies by original (unsquared) argument when done, + 72 ;for computing odd-degree polynomials (like SIN). + 73 0036 FF 36 0000 E PUSH [$AC] + 74 003A FF 36 0002 E PUSH [$AC+2] + 75 003E E8 0000 R CALL $SPOLY2 ;Compute polynomial on square on argument + 76 0041 BE 0000 E MOV SI,OFFSET DC:$ARG + 77 0044 8F 44 02 POP [SI+2] + 78 0047 8F 04 POP [SI] + 79 0049 BF 0000 E MOV DI,OFFSET DC:$AC + 80 004C E9 0000 E JMP $SMUL ;Multiply by original argument (unsquared) + 81 + 82 + 83 ;*** $DPOLY & $DPOLY2 - Evaluate DP polynomial + 84 ; + 85 ; Inputs: + 86 ; BX = Address of list of coefficients. First byte in list is number of + 87 ; coefficients, followed by the constants ordered from highest + 88 ; power to lowest. + 89 ; FAC = argument. + 90 ; Function: + 91 ; Evaluate polynomial by Horner's method + 92 ; Outputs: + 93 ; Result in FAC. + 94 ; Registers: + 95 ; ALL destroyed. + 96 + 97 004F $DPOLY2: + 98 ;Compute polynomial on square of argument + 99 004F 53 PUSH BX + 100 0050 BE 0000 E MOV SI,OFFSET DC:$DAC + 101 0053 8B FE MOV DI,SI + 102 0055 E8 0000 E CALL $DMUL ;Square the argument + 103 0058 5B POP BX + 104 0059 $DPOLY: + 105 0059 BE 0000 E MOV SI,OFFSET DC:$DAC + 106 005C BF 0000 E MOV DI,OFFSET DC:$ARG ;Local storage for argument + 107 005F A5 MOVSW + 108 0060 A5 MOVSW + + +POLY - Polynomial evaluator for transcendental functions Macro-86 %1(12) 1:6:40 13-Nov-81 Page 1-3 + + + + 109 0061 A5 MOVSW + 110 0062 A5 MOVSW ;Save argument + 111 0063 8B F3 MOV SI,BX ;Point to coefficient table + 112 0065 AD LODSW ;Number of coefficients + 113 0066 91 XCHG AX,CX ;Count in CX + 114 0067 BF 0000 E MOV DI,OFFSET DC:$DAC + 115 006A A5 MOVSW ;Move first coefficient into FAC + 116 006B A5 MOVSW + 117 006C A5 MOVSW + 118 006D A5 MOVSW + 119 006E DPOLYLOOP: + 120 006E 51 PUSH CX + 121 006F 56 PUSH SI + 122 0070 BE 0000 E MOV SI,OFFSET DC:$DAC + 123 0073 BF 0000 E MOV DI,OFFSET DC:$ARG + 124 0076 E8 0000 E CALL $DMUL ;Multiply by argument + 125 0079 5E POP SI ;Recover pointer to next coefficient + 126 007A 56 PUSH SI + 127 007B BF 0000 E MOV DI,OFFSET DC:$DAC + 128 007E E8 0000 E CALL $DADD ;Add coefficient + 129 0081 5E POP SI + 130 0082 59 POP CX + 131 0083 83 C6 08 ADD SI,8 ;Bump to next coefficient + 132 0086 E2 E6 LOOP DPOLYLOOP + 133 0088 C3 RET + 134 + 135 0089 $DPOLYX: + 136 ;Same as $DPOLY2, but multiplies by original (unsquared) argument when done, + 137 ;for computing odd-degree polynomials (like SIN). + 138 0089 FF 36 0000 E PUSH [$DAC] + 139 008D FF 36 0002 E PUSH [$DAC+2] + 140 0091 FF 36 0004 E PUSH [$DAC+4] + 141 0095 FF 36 0006 E PUSH [$DAC+6] + 142 0099 E8 004F R CALL $DPOLY2 ;Compute polynomial on square on argument + 143 009C BE 0000 E MOV SI,OFFSET DC:$ARG + 144 009F 8F 44 06 POP [SI+6] + 145 00A2 8F 44 04 POP [SI+4] + 146 00A5 8F 44 02 POP [SI+2] + 147 00A8 8F 04 POP [SI] + 148 00AA BF 0000 E MOV DI,OFFSET DC:$DAC + 149 00AD E9 0000 E JMP $DMUL ;Multiply by original argument (unsquared) + 150 + 151 00B0 CODE ENDS + 152 END + + + + + + + + + + + + +POLY - Polynomial evaluator for transcendental functions Macro-86 %1(12) 1:6:40 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 00B0 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +DPOLYLOOP. . . . . . . . . . . . L NEAR 006E CODE +SPOLYLOOP. . . . . . . . . . . . L NEAR 001B CODE +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$DAC . . . . . . . . . . . . . . V WORD 0000 DATA External +$DADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DPOLY . . . . . . . . . . . . . L NEAR 0059 CODE Global +$DPOLY2. . . . . . . . . . . . . L NEAR 004F CODE Global +$DPOLYX. . . . . . . . . . . . . L NEAR 0089 CODE Global +$SADD. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SPOLY . . . . . . . . . . . . . L NEAR 000A CODE Global +$SPOLY2. . . . . . . . . . . . . L NEAR 0000 CODE Global +$SPOLYX. . . . . . . . . . . . . L NEAR 0036 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/POLY.ASM b/3_source_code/BASLIB-86/POLY.ASM new file mode 100644 index 0000000..de96804 --- /dev/null +++ b/3_source_code/BASLIB-86/POLY.ASM @@ -0,0 +1,152 @@ + TITLE POLY - Polynomial evaluator for transcendental functions + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $AC:WORD, $DAC:WORD, $ARG:WORD + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $SPOLY, $SPOLY2, $SPOLYX, $DPOLY, $DPOLY2, $DPOLYX + + EXTRN $SMUL:NEAR, $SADD:NEAR, $DMUL:NEAR, $DADD:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $SPOLY, $SPOLY2, & $SPOLYX - Evaluate SP polynomial +; +; Inputs: +; BX = Address of list of coefficients. First byte in list is nmber of +; coefficients, followed by the constants ordered from highest +; power to lowest. +; FAC = argument. +; Function: +; Evaluate polynomial by Horner's method +; Outputs: +; Result in FAC. +; Registers: +; ALL destroyed. + +$SPOLY2: +;Compute polynomial on square of argument + PUSH BX + MOV SI,OFFSET DC:$AC + MOV DI,SI + CALL $SMUL ;Square the argument + POP BX +$SPOLY: + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG ;Local stroage for argument + MOVSW + MOVSW ;Save argument + MOV SI,BX ;Point to coefficient table + LODSW ;Number of coefficients + XCHG AX,CX ;Count in CX + MOV DI,OFFSET DC:$AC + MOVSW ;Move first coefficient into FAC + MOVSW +SPOLYLOOP: + PUSH CX + PUSH SI + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG + CALL $SMUL ;Multiply by argument + POP SI ;Recover pointer to next coefficient + PUSH SI + MOV DI,OFFSET DC:$AC + CALL $SADD ;Add coefficient + POP SI + POP CX + ADD SI,4 ;Bump to next coefficient + LOOP SPOLYLOOP + RET + +$SPOLYX: +;Same as $SPOLY2, but multiplies by original (unsquared) argument when done, +;for computing odd-degree polynomials (like SIN). + PUSH [$AC] + PUSH [$AC+2] + CALL $SPOLY2 ;Compute polynomial on square on argument + MOV SI,OFFSET DC:$ARG + POP [SI+2] + POP [SI] + MOV DI,OFFSET DC:$AC + JMP $SMUL ;Multiply by original argument (unsquared) + + +;*** $DPOLY & $DPOLY2 - Evaluate DP polynomial +; +; Inputs: +; BX = Address of list of coefficients. First byte in list is number of +; coefficients, followed by the constants ordered from highest +; power to lowest. +; FAC = argument. +; Function: +; Evaluate polynomial by Horner's method +; Outputs: +; Result in FAC. +; Registers: +; ALL destroyed. + +$DPOLY2: +;Compute polynomial on square of argument + PUSH BX + MOV SI,OFFSET DC:$DAC + MOV DI,SI + CALL $DMUL ;Square the argument + POP BX +$DPOLY: + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG ;Local storage for argument + MOVSW + MOVSW + MOVSW + MOVSW ;Save argument + MOV SI,BX ;Point to coefficient table + LODSW ;Number of coefficients + XCHG AX,CX ;Count in CX + MOV DI,OFFSET DC:$DAC + MOVSW ;Move first coefficient into FAC + MOVSW + MOVSW + MOVSW +DPOLYLOOP: + PUSH CX + PUSH SI + MOV SI,OFFSET DC:$DAC + MOV DI,OFFSET DC:$ARG + CALL $DMUL ;Multiply by argument + POP SI ;Recover pointer to next coefficient + PUSH SI + MOV DI,OFFSET DC:$DAC + CALL $DADD ;Add coefficient + POP SI + POP CX + ADD SI,8 ;Bump to next coefficient + LOOP DPOLYLOOP + RET + +$DPOLYX: +;Same as $DPOLY2, but multiplies by original (unsquared) argument when done, +;for computing odd-degree polynomials (like SIN). + PUSH [$DAC] + PUSH [$DAC+2] + PUSH [$DAC+4] + PUSH [$DAC+6] + CALL $DPOLY2 ;Compute polynomial on square on argument + MOV SI,OFFSET DC:$ARG + POP [SI+6] + POP [SI+4] + POP [SI+2] + POP [SI] + MOV DI,OFFSET DC:$DAC + JMP $DMUL ;Multiply by original argument (unsquared) + +CODE ENDS + END From 7150fd70248003c5ec842f66f471ffa809fc6cd8 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 4 Aug 2026 16:48:15 -0700 Subject: [PATCH 46/53] Corrected data entry error in OUT.ASM --- 2_printed_files/bundle_09/OUT.ASM | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/2_printed_files/bundle_09/OUT.ASM b/2_printed_files/bundle_09/OUT.ASM index f0d6201..a9c282a 100644 --- a/2_printed_files/bundle_09/OUT.ASM +++ b/2_printed_files/bundle_09/OUT.ASM @@ -382,6 +382,7 @@ FB_NUM . . . . . . . . . . . . . Number FFFB FCB_LENGTH . . . . . . . . . . . Number 0026 FILNAML. . . . . . . . . . . . . Number 0026 FILNAM_LENGTH. . . . . . . . . . Number 000B +LAST_DEVICE_OFFSET . . . . . . . Number 0008 LF . . . . . . . . . . . . . . . Number 000A MD_APP . . . . . . . . . . . . . Number 0008 MD_BIN . . . . . . . . . . . . . Number 0080 @@ -417,7 +418,6 @@ _MSDOS_. . . . . . . . . . . . . Number 0001 ___DEV . . . . . . . . . . . . . Number FFFC ___ZZZ . . . . . . . . . . . . . Number 0018 - OUT - Output utilities Macro-86 %1(12) 1:6:27 13-Nov-81 Symbols-3 From 7080a36d845ab0164047a4775d73a236190e3721 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Tue, 4 Aug 2026 16:49:59 -0700 Subject: [PATCH 47/53] Transcription of Bundle 9 - PR0A.ASM Code and Listing --- 2_printed_files/bundle_09/PR0A.ASM | 361 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/PR0A.ASM | 85 +++++++ 2 files changed, 446 insertions(+) create mode 100644 2_printed_files/bundle_09/PR0A.ASM create mode 100644 3_source_code/BASLIB-86/PR0A.ASM diff --git a/2_printed_files/bundle_09/PR0A.ASM b/2_printed_files/bundle_09/PR0A.ASM new file mode 100644 index 0000000..7d82073 --- /dev/null +++ b/2_printed_files/bundle_09/PR0A.ASM @@ -0,0 +1,361 @@ +PR0A - Prepare for printing Macro-86 %1(12) 1:6:45 13-Nov-81 Page 1-1 + + + + 1 TITLE PR0A - Prepare for printing + 2 + 3 ; *PR0A - PRINT, no USING, no # + 4 ; PR0B - PRINT USING + 5 ; *PR0C - PRINT # + 6 ; PR0D - PRINT USING # + 7 ; *PR0E - LPRINT + 8 ; PR0F - LPRINT USING + 9 ; *WRI - WRITE + 10 ; *WRD - WRITE # + 11 ; * Only these included in this module + 12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PR0A - Prepare for printing Macro-86 %1(12) 1:6:45 13-Nov-81 Page 1-2 + + + + 13 .list + 14 + 15 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 16 + 17 EXTRN $$PUFL:BYTE,$$WRFL:BYTE,$PTRFIL:WORD,$$SPSV:WORD + 18 + 19 0000 DATA ENDS + 20 + 21 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 22 + 23 EXTRN $LPTFDB:BYTE + 24 + 25 0000 CONST ENDS + 26 + 27 DC GROUP CONST,DATA + 28 + 29 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 30 + 31 PUBLIC $PR0A,$PR0C,$PR0E,$WRI,$WRD + 32 + 33 EXTRN $FBLOC:NEAR + 34 EXTRN $ERC_IFN:NEAR,$ERC_BFM:NEAR + 35 + 36 ASSUME CS:CODE,DS:DC,ES:DC + 37 + 38 0000 Entries PROC FAR + 39 + 40 0000 C6 06 0000 E 00 $PR0A: MOV [$$WRFL],0 + 41 + 42 0005 C7 06 0000 E 0000 pr0: MOV [$PTRFIL],0 + 43 + 44 000B C6 06 0000 E 00 pr1: MOV [$$PUFL],0 + 45 0010 CB RET + 46 + 47 0011 C6 06 0000 E 01 $WRI: MOV [$$WRFL],1 + 48 0016 EB ED JMP pr0 + 49 + 50 0018 E8 0035 R $PR0C: CALL pr0c + 51 001B EB 07 90 JMP pr3 + 52 + 53 001E C7 06 0000 E 0000 E $PR0E: MOV [$PTRFIL],OFFSET DC:$LPTFDB + 54 + 55 0024 C6 06 0000 E 00 pr3: MOV [$$WRFL],0 + 56 0029 EB E0 JMP pr1 + 57 + 58 002B E8 0035 R $WRD: CALL pr0c + 59 002E C6 06 0000 E 01 MOV [$$WRFL],1 + 60 0033 EB D6 JMP pr1 + 61 + 62 0035 Entries ENDP + 63 + 64 0035 Locals PROC NEAR + 65 + 66 0035 89 26 0000 E pr0c: MOV [$$SPSV],SP + + +PR0A - Prepare for printing Macro-86 %1(12) 1:6:45 13-Nov-81 Page 1-3 + + + + 67 0039 83 06 0000 E 02 ADD [$$SPSV],2 + 68 003E 56 PUSH SI + 69 003F E8 0000 E CALL $FBLOC ;See if file exists + 70 0042 74 0B JZ ercifn + 71 0044 80 3C 01 CMP [SI].FD_MODE,MD_SQI + 72 0047 74 09 JE ercbfm + 73 0049 89 36 0000 E MOV [$PTRFIL],SI + 74 004D 5E POP SI + 75 004E C3 RET + 76 + 77 004F E9 0000 E ercifn: JMP $ERC_IFN + 78 + 79 0052 E9 0000 E ercbfm: JMP $ERC_BFM + 80 + 81 0055 Locals ENDP + 82 + 83 0055 CODE ENDS + 84 + 85 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PR0A - Prepare for printing Macro-86 %1(12) 1:6:45 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0055 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0000 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E + + +PR0A - Prepare for printing Macro-86 %1(12) 1:6:45 13-Nov-81 Symbols-2 + + + +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +ENTRIES. . . . . . . . . . . . . F PROC 0000 CODE Length =0035 +EOFCHR . . . . . . . . . . . . . Number 001A +ERCBFM . . . . . . . . . . . . . L NEAR 0052 CODE +ERCIFN . . . . . . . . . . . . . L NEAR 004F CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +LOCALS . . . . . . . . . . . . . N PROC 0035 CODE Length =0020 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +PR0. . . . . . . . . . . . . . . L NEAR 0005 CODE +PR0C . . . . . . . . . . . . . . L NEAR 0035 CODE +PR1. . . . . . . . . . . . . . . L NEAR 000B CODE +PR3. . . . . . . . . . . . . . . L NEAR 0024 CODE +REC_LENGTH . . . . . . . . . . . Number 0080 +$$PUFL . . . . . . . . . . . . . V BYTE 0000 DATA External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$WRFL . . . . . . . . . . . . . V BYTE 0000 DATA External +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IFN . . . . . . . . . . . . L NEAR 0000 CODE External +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE External +$LPTFDB. . . . . . . . . . . . . V BYTE 0000 CONST External +$PR0A. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$PR0C. . . . . . . . . . . . . . L NEAR 0018 CODE Global +$PR0E. . . . . . . . . . . . . . L NEAR 001E CODE Global +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +$WRD . . . . . . . . . . . . . . L NEAR 002B CODE Global +$WRI . . . . . . . . . . . . . . L NEAR 0011 CODE Global +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + + +PR0A - Prepare for printing Macro-86 %1(12) 1:6:45 13-Nov-81 Symbols-3 + + + + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/PR0A.ASM b/3_source_code/BASLIB-86/PR0A.ASM new file mode 100644 index 0000000..8af9e57 --- /dev/null +++ b/3_source_code/BASLIB-86/PR0A.ASM @@ -0,0 +1,85 @@ + TITLE PR0A - Prepare for printing + +; *PR0A - PRINT, no USING, no # +; PR0B - PRINT USING +; *PR0C - PRINT # +; PR0D - PRINT USING # +; *PR0E - LPRINT +; PR0F - LPRINT USING +; *WRI - WRITE +; *WRD - WRITE # +; * Only these included in this module + +.list + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$PUFL:BYTE,$$WRFL:BYTE,$PTRFIL:WORD,$$SPSV:WORD + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $LPTFDB:BYTE + +CONST ENDS + +DC GROUP CONST,DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $PR0A,$PR0C,$PR0E,$WRI,$WRD + + EXTRN $FBLOC:NEAR + EXTRN $ERC_IFN:NEAR,$ERC_BFM:NEAR + + ASSUME CS:CODE,DS:DC,ES:DC + +Entries PROC FAR + +$PR0A: MOV [$$WRFL],0 + +pr0: MOV [$PTRFIL],0 + +pr1: MOV [$$PUFL],0 + RET + +$WRI: MOV [$$WRFL],1 + JMP pr0 + +$PR0C: CALL pr0c + JMP pr3 + +$PR0E: MOV [$PTRFIL],OFFSET DC:$LPTFDB + +pr3: MOV [$$WRFL],0 + JMP pr1 + +$WRD: CALL pr0c + MOV [$$WRFL],1 + JMP pr1 + +Entries ENDP + +Locals PROC NEAR + +pr0c: MOV [$$SPSV],SP + ADD [$$SPSV],2 + PUSH SI + CALL $FBLOC ;See if file exists + JZ ercifn + CMP [SI].FD_MODE,MD_SQI + JE ercbfm + MOV [$PTRFIL],SI + POP SI + RET + +ercifn: JMP $ERC_IFN + +ercbfm: JMP $ERC_BFM + +Locals ENDP + +CODE ENDS + + END From 99a38213bf941cbc5fec6d8b770c1225ae11241a Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 5 Aug 2026 12:11:06 -0700 Subject: [PATCH 48/53] Transcription of Bundle 9 - PR0B.ASM Code and Listing NOTE there are several extra records in the symbol table that are not in the source code for the listing. This results in "Symbol not defined" error at line 51. This is also in PR0A.ASM at line 71, I forgot to note in previous commit. This is due to assembler directives to mask the includes. Other include files already added to this PR can be added to the source file to remove the errors. Specifically DEVDEF.INC and SYSTEM.INC. --- 2_printed_files/bundle_09/PR0B.ASM | 241 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/PR0B.ASM | 66 ++++++++ 2 files changed, 307 insertions(+) create mode 100644 2_printed_files/bundle_09/PR0B.ASM create mode 100644 3_source_code/BASLIB-86/PR0B.ASM diff --git a/2_printed_files/bundle_09/PR0B.ASM b/2_printed_files/bundle_09/PR0B.ASM new file mode 100644 index 0000000..6ab7208 --- /dev/null +++ b/2_printed_files/bundle_09/PR0B.ASM @@ -0,0 +1,241 @@ +PR0B - Prepare for printing with PRINT USING Macro-86 %1(12) 1:6:56 13-Nov-81 Page 1-1 + + + + 1 TITLE PR0B - Prepare for printing with PRINT USING + 2 + 3 ; PR0A - PRINT, no USING, no # + 4 ; *PR0B - PRINT USING + 5 ; PR0C - PRINT # + 6 ; *PR0D - PRINT USING # + 7 ; PR0E - LPRINT + 8 ; *PR0F - LPRINT USING + 9 ; WRI - WRITE + 10 ; WRD - WRITE # + 11 ; * Only these included in this module + 12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PR0B - Prepare for printing with PRINT USING Macro-86 %1(12) 1:6:56 13-Nov-81 Page 1-2 + + + + 13 .list + 14 + 15 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 16 + 17 EXTRN $$PUFL:BYTE,$$WRFL:BYTE,$PTRFIL:WORD,$$SPSV:WORD + 18 + 19 0000 DATA ENDS + 20 + 21 0000 CONST SEGMENT WORD PUBLIC 'CONST' + 22 + 23 EXTRN $LPTFDB:BYTE + 24 + 25 0000 CONST ENDS + 26 + 27 DC GROUP CONST,DATA + 28 + 29 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 30 + 31 PUBLIC $PR0B,$PR0D,$PR0F + 32 + 33 EXTRN $FBLOC:NEAR, $PRU:NEAR + 34 EXTRN $ERC_IFN:NEAR,$ERC_BFM:NEAR + 35 + 36 ASSUME CS:CODE,DS:DC,ES:DC + 37 + 38 + 39 0000 $PR0B: + 40 0000 C7 06 0000 E 0000 MOV [$PTRFIL],0 + 41 0006 PR1: + 42 0006 C6 06 0000 E 00 MOV [$$WRFL],0 + 43 000B E9 0000 E JMP $PRU + 44 + 45 000E $PR0D: + 46 000E 89 26 0000 E MOV [$$SPSV],SP + 47 0012 56 PUSH SI + 48 0013 87 DA XCHG BX,DX ;Swap file # into (BX) + 49 0015 E8 0000 E CALL $FBLOC ;See if file exists + 50 0018 74 16 JZ ercifn + 51 001A 80 3C 01 CMP [SI].FD_MODE,MD_SQI + 52 001D 74 14 JE ercbfm + 53 001F 89 36 0000 E MOV [$PTRFIL],SI + 54 0023 87 DA XCHG BX,DX ;Swap string desc back into (BX) + 55 0025 5E POP SI + 56 0026 EB DE JMP PR1 + 57 + 58 0028 C7 06 0000 E 0000 E $PR0F: MOV [$PTRFIL],OFFSET DC:$LPTFDB + 59 002E EB D6 JMP PR1 + 60 + 61 0030 E9 0000 E ercifn: JMP $ERC_IFN + 62 + 63 0033 E9 0000 E ercbfm: JMP $ERC_BFM + 64 + 65 0036 CODE ENDS + 66 END + + +PR0B - Prepare for printing with PRINT USING Macro-86 %1(12) 1:6:56 13-Nov-81 Symbols-1 + + + +Macros: + + N a m e Length + +DEVMAC . . . . . . . . . . . . . 0002 +DEVNAM . . . . . . . . . . . . . 0005 +DSPMAC . . . . . . . . . . . . . 0001 +DSPNAM . . . . . . . . . . . . . 000E +ENT. . . . . . . . . . . . . . . 0002 +ENTI . . . . . . . . . . . . . . 0002 +ENTORG . . . . . . . . . . . . . 0001 + +Structures and records: + + N a m e Width # fields + Shift Width Mask Initial + +FILE_DATA_BLOCK. . . . . . . . . 00BD 0012 + FD_MODE. . . . . . . . . . . . . 0000 + FD_FCB . . . . . . . . . . . . . 0001 + FD_CURLOC. . . . . . . . . . . . 0027 + FD_ORNOFS. . . . . . . . . . . . 0029 + FD_NMLOFS. . . . . . . . . . . . 002A + FD_DEVICE. . . . . . . . . . . . 002E + FD_WIDTH . . . . . . . . . . . . 002F + FD_POS . . . . . . . . . . . . . 0030 + FD_FLAGS . . . . . . . . . . . . 0031 + FD_OUTPOS. . . . . . . . . . . . 0032 + FD_BUFFER. . . . . . . . . . . . 0033 + FR_VRECL . . . . . . . . . . . . 00B3 + FR_PHYREC. . . . . . . . . . . . 00B5 + FR_LOGREC. . . . . . . . . . . . 00B7 + FR_OUTPOS. . . . . . . . . . . . 00BA + FR_FIELD . . . . . . . . . . . . 00BC + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0036 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + CONST. . . . . . . . . . . . . . 0000 WORD PUBLIC 'CONST' + DATA . . . . . . . . . . . . . . 0000 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +BL_LEN . . . . . . . . . . . . . Number FFFC +BL_LNK . . . . . . . . . . . . . Number FFFE +BL_SIZE. . . . . . . . . . . . . Number FFFA +DN_KYBD. . . . . . . . . . . . . Number FFFF +DN_LPT1. . . . . . . . . . . . . Number FFFD +DN_SCRN. . . . . . . . . . . . . Number FFFE +DV_BAKC. . . . . . . . . . . . . Number 000E + + +PR0B - Prepare for printing with PRINT USING Macro-86 %1(12) 1:6:56 13-Nov-81 Symbols-2 + + + +DV_CLOSE . . . . . . . . . . . . Number 0006 +DV_EOF . . . . . . . . . . . . . Number 0000 +DV_GPOS. . . . . . . . . . . . . Number 0014 +DV_GWID. . . . . . . . . . . . . Number 0016 +DV_LOC . . . . . . . . . . . . . Number 0002 +DV_LOF . . . . . . . . . . . . . Number 0004 +DV_OPEN. . . . . . . . . . . . . Number 000C +DV_RANDIO. . . . . . . . . . . . Number 000A +DV_SINP. . . . . . . . . . . . . Number 0010 +DV_SOUT. . . . . . . . . . . . . Number 0012 +DV_TABLEN. . . . . . . . . . . . Number 0018 +DV_WIDTH . . . . . . . . . . . . Number 0008 +EOFCHR . . . . . . . . . . . . . Number 001A +ERCBFM . . . . . . . . . . . . . L NEAR 0033 CODE +ERCIFN . . . . . . . . . . . . . L NEAR 0030 CODE +FB_NUM . . . . . . . . . . . . . Number FFFB +FCB_LENGTH . . . . . . . . . . . Number 0026 +FILNAML. . . . . . . . . . . . . Number 0026 +FILNAM_LENGTH. . . . . . . . . . Number 000B +LAST_DEVICE_OFFSET . . . . . . . Number 0008 +MD_APP . . . . . . . . . . . . . Number 0008 +MD_BIN . . . . . . . . . . . . . Number 0080 +MD_FIL . . . . . . . . . . . . . Number 0004 +MD_IBM . . . . . . . . . . . . . Number 0020 +MD_KIL . . . . . . . . . . . . . Number 0010 +MD_RND . . . . . . . . . . . . . Number 0004 +MD_SQI . . . . . . . . . . . . . Number 0001 +MD_SQO . . . . . . . . . . . . . Number 0002 +MD_USR . . . . . . . . . . . . . Number 0040 +PR1. . . . . . . . . . . . . . . L NEAR 0006 CODE +REC_LENGTH . . . . . . . . . . . Number 0080 +$$PUFL . . . . . . . . . . . . . V BYTE 0000 DATA External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$WRFL . . . . . . . . . . . . . V BYTE 0000 DATA External +$ERC_BFM . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_IFN . . . . . . . . . . . . L NEAR 0000 CODE External +$FBLOC . . . . . . . . . . . . . L NEAR 0000 CODE External +$LPTFDB. . . . . . . . . . . . . V BYTE 0000 CONST External +$PR0B. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$PR0D. . . . . . . . . . . . . . L NEAR 000E CODE Global +$PR0F. . . . . . . . . . . . . . L NEAR 0028 CODE Global +$PRU . . . . . . . . . . . . . . L NEAR 0000 CODE External +$PTRFIL. . . . . . . . . . . . . V WORD 0000 DATA External +_CPM_. . . . . . . . . . . . . . Number 0000 +_IBM_. . . . . . . . . . . . . . Number 0000 +_MSDOS_. . . . . . . . . . . . . Number 0001 +___DEV . . . . . . . . . . . . . Number FFFC +___ZZZ . . . . . . . . . . . . . Number 0018 + +Warning Severe +Errors Errors +0 0 + + + + diff --git a/3_source_code/BASLIB-86/PR0B.ASM b/3_source_code/BASLIB-86/PR0B.ASM new file mode 100644 index 0000000..0fc9509 --- /dev/null +++ b/3_source_code/BASLIB-86/PR0B.ASM @@ -0,0 +1,66 @@ + TITLE PR0B - Prepare for printing with PRINT USING + +; PR0A - PRINT, no USING, no # +; *PR0B - PRINT USING +; PR0C - PRINT # +; *PR0D - PRINT USING # +; PR0E - LPRINT +; *PR0F - LPRINT USING +; WRI - WRITE +; WRD - WRITE # +; * Only these included in this module + +.list + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $$PUFL:BYTE,$$WRFL:BYTE,$PTRFIL:WORD,$$SPSV:WORD + +DATA ENDS + +CONST SEGMENT WORD PUBLIC 'CONST' + + EXTRN $LPTFDB:BYTE + +CONST ENDS + +DC GROUP CONST,DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $PR0B,$PR0D,$PR0F + + EXTRN $FBLOC:NEAR, $PRU:NEAR + EXTRN $ERC_IFN:NEAR,$ERC_BFM:NEAR + + ASSUME CS:CODE,DS:DC,ES:DC + + +$PR0B: + MOV [$PTRFIL],0 +PR1: + MOV [$$WRFL],0 + JMP $PRU + +$PR0D: + MOV [$$SPSV],SP + PUSH SI + XCHG BX,DX ;Swap file # into (BX) + CALL $FBLOC ;See if file exists + JZ ercifn + CMP [SI].FD_MODE,MD_SQI + JE ercbfm + MOV [$PTRFIL],SI + XCHG BX,DX ;Swap string desc back into (BX) + POP SI + JMP PR1 + +$PR0F: MOV [$PTRFIL],OFFSET DC:$LPTFDB + JMP PR1 + +ercifn: JMP $ERC_IFN + +ercbfm: JMP $ERC_BFM + +CODE ENDS + END From ed81533d7422dac4e6bdb13cb06babe6ce71b2fc Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 5 Aug 2026 13:15:23 -0700 Subject: [PATCH 49/53] Transcription of Bundle 9 - PRNVAL.ASM Code and Listing --- 2_printed_files/bundle_09/PRNVAL.ASM | 420 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/PRNVAL.ASM | 233 +++++++++++++++ 2 files changed, 653 insertions(+) create mode 100644 2_printed_files/bundle_09/PRNVAL.ASM create mode 100644 3_source_code/BASLIB-86/PRNVAL.ASM diff --git a/2_printed_files/bundle_09/PRNVAL.ASM b/2_printed_files/bundle_09/PRNVAL.ASM new file mode 100644 index 0000000..97f22d1 --- /dev/null +++ b/2_printed_files/bundle_09/PRNVAL.ASM @@ -0,0 +1,420 @@ +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Page 1-1 + + + + 1 TITLE PRNVAL - Print values + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 PUBLIC $$WRFL,$$PUFL,$$PUEN + 6 + 7 EXTRN $$SPSV:WORD,$FAC:BYTE,$AC:WORD + 8 EXTRN TYP:WORD,VALTYP:BYTE,CURTYP:BYTE + 9 + 10 0000 ?? $$WRFL DB ? + 11 0001 ?? $$PUFL DB ? + 12 0002 ???? $$PUEN DW ? + 13 + 14 0004 DATA ENDS + 15 + 16 DC GROUP DATA + 17 + 18 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 19 + 20 PUBLIC $PV0A,$PV0B,$PV0C,$PV0D + 21 PUBLIC $PV1A,$PV1B,$PV1C,$PV1D + 22 PUBLIC $PV2A,$PV2B,$PV2C,$PV2D + 23 + 24 EXTRN $$WCH:NEAR,$$WCLF:NEAR,$$DITS:NEAR,$FOUT:NEAR + 25 EXTRN $TYPSTR:NEAR,$SAVREG:NEAR + 26 EXTRN $$POS:NEAR,$$WID:NEAR + 27 + 28 ASSUME CS:CODE, DS:DC, ES:DC + 29 + 30 + 31 ;*** PVnx - Print values + 32 ; + 33 ; n = 0 - follow with "," processing + 34 ; 1 - follow with ";" processing + 35 ; 2 - follow with CR/LF + 36 ; + 37 ; x = A - Single precision (pointer to value in BX) + 38 ; B - Double precision (pointer to value in BX) + 39 ; C - Integer (value in BX) + 40 ; D - String (Address of descriptor in BX) + 41 + 42 = 000E CLMWID EQU 14 + 43 = 0004 SNGL EQU 4 + 44 = 0008 DBL EQU 8 + 45 = 0002 INT EQU 2 + 46 = 0003 STRING EQU 3 + 47 = 0000 COMMA EQU 0 + 48 = 0001 SEMI EQU 1 + 49 = 0002 CRLF EQU 2 + 50 + 51 0000 $PV0A: + 52 0000 E8 003C R CALL PRINT + 53 0003 04 00 DB SNGL,COMMA + 54 + + +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Page 1-2 + + + + 55 0005 $PV0B: + 56 0005 E8 003C R CALL PRINT + 57 0008 08 00 DB DBL,COMMA + 58 + 59 000A $PV0C: + 60 000A E8 003C R CALL PRINT + 61 000D 02 00 DB INT,COMMA + 62 + 63 000F $PV0D: + 64 000F E8 003C R CALL PRINT + 65 0012 03 00 DB STRING,COMMA + 66 + 67 0014 $PV1A: + 68 0014 E8 003C R CALL PRINT + 69 0017 04 01 DB SNGL,SEMI + 70 + 71 0019 $PV1B: + 72 0019 E8 003C R CALL PRINT + 73 001C 08 01 DB DBL,SEMI + 74 + 75 001E $PV1C: + 76 001E E8 003C R CALL PRINT + 77 0021 02 01 DB INT,SEMI + 78 + 79 0023 $PV1D: + 80 0023 E8 003C R CALL PRINT + 81 0026 03 01 DB STRING,SEMI + 82 + 83 0028 $PV2A: + 84 0028 E8 003C R CALL PRINT + 85 002B 04 02 DB SNGL,CRLF + 86 + 87 002D $PV2B: + 88 002D E8 003C R CALL PRINT + 89 0030 08 02 DB DBL,CRLF + 90 + 91 0032 $PV2C: + 92 0032 E8 003C R CALL PRINT + 93 0035 02 02 DB INT,CRLF + 94 + 95 0037 $PV2D: + 96 0037 E8 003C R CALL PRINT + 97 003A 03 02 DB STRING,CRLF + 98 + 99 003C PRINT: + 100 003C 8F 06 0000 E POP [TYP] ;Get pointer to flags + 101 0040 E8 0000 E CALL $SAVREG + 102 0043 8B 36 0000 E MOV SI,[TYP] + 103 0047 2E: AD LODS WORD PTR CS:[SI] + 104 0049 A3 0000 E MOV [TYP],AX ;Set VALTYP and CURTYP flags + 105 004C 3C 03 CMP AL,STRING + 106 004E 74 56 JZ PSTRG ;Handle strings separately + 107 0050 3C 02 CMP AL,INT + 108 0052 74 10 JZ STOINT + + +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Page 1-3 + + + + 109 0054 98 CBW + 110 0055 8B F3 MOV SI,BX + 111 0057 BF 0001 E MOV DI,OFFSET DC:$FAC+1 + 112 005A 2B F8 SUB DI,AX ;Point to DAC or AC, as appropriate + 113 005C 8B C8 MOV CX,AX + 114 005E D1 E9 SHR CX,1 ;Move by words + 115 0060 F3/ A5 REP MOVSW ;Number to print in FAC + 116 0062 EB 04 JMP SHORT TSTPRUS + 117 0064 STOINT: + 118 0064 89 1E 0000 E MOV [$AC],BX ;Number to print in FAC + 119 0068 TSTPRUS: + 120 0068 80 3E 0001 R 00 CMP [$$PUFL],0 ;Print using on? + 121 006D 75 2B JNZ PUEN ;Yes--go do it + 122 006F E8 0000 E CALL $FOUT ;Convert it to ASCII + 123 0072 80 3E 0000 R 00 CMP [$$WRFL],0 ;WRITE statement? + 124 0077 75 62 JNZ WRVAL ;Yes--handle special + 125 0079 40 INC AX ;Add 1 for the following space + 126 007A B1 00 MOV CL,0 ;Not special comma test + 127 007C E8 0113 R CALL PRTCHK ;Make it fit on line (give CR/LF if necessary) + 128 007F PRVAL: + 129 007F AC LODSB + 130 0080 0A C0 OR AL,AL ;End of string? + 131 0082 74 05 JZ WRTSPC + 132 0084 E8 0000 E CALL $$WCH ;Write character + 133 0087 EB F6 JMP PRVAL + 134 0089 WRTSPC: + 135 0089 B0 20 MOV AL," " + 136 008B CHKEND: + 137 008B 80 3E 0000 E 01 CMP [CURTYP],SEMI ;What do we finish with? + 138 0090 74 05 JZ WRTJMP + 139 0092 STREND: + 140 0092 72 5B JB CMA ;Comma processing? + 141 0094 E9 0000 E ENDLIN: JMP $$WCLF + 142 + 143 0097 E9 0000 E WRTJMP: JMP $$WCH + 144 + 145 009A FF 16 0002 R PUEN: CALL [$$PUEN] + 146 009E 80 3E 0000 E 02 CMP [CURTYP],CRLF + 147 00A3 74 EF JZ ENDLIN + 148 00A5 C3 RET + 149 + 150 00A6 PSTRG: + 151 00A6 80 3E 0001 R 00 CMP [$$PUFL],0 ;Check for PRINT USING + 152 00AB 75 ED JNZ PUEN + 153 00AD 80 3E 0000 R 00 CMP [$$WRFL],0 ;WRITE? + 154 00B2 75 15 JNZ WRTSTR + 155 00B4 8B 07 MOV AX,[BX] ;Get length in AX + 156 00B6 B1 00 MOV CL,0 ;No special comma test + 157 00B8 E8 0113 R CALL PRTCHK ;Try to make it fit on the line + 158 00BB E8 0000 E CALL $TYPSTR ;Output the string + 159 00BE E8 0000 E CALL $$DITS ;Delete it if temporary string + 160 00C1 80 3E 0000 E 01 CMP [CURTYP],SEMI ;What do we finish with? + 161 00C6 75 CA JNZ STREND + 162 00C8 C3 RET + + +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Page 1-4 + + + + 163 + 164 00C9 WRTSTR: + 165 00C9 B0 22 MOV AL,'"' + 166 00CB E8 0000 E CALL $$WCH + 167 00CE E8 0000 E CALL $TYPSTR + 168 00D1 E8 0000 E CALL $$DITS + 169 00D4 B0 22 MOV AL,'"' + 170 00D6 E8 0000 E CALL $$WCH + 171 00D9 EB 10 JMP SHORT WRTTST + 172 + 173 00DB WRVAL: + 174 00DB 80 3C 20 CMP BYTE PTR[SI]," " ;Is first letter a blank? + 175 00DE 75 01 JNZ WRTVAL + 176 00E0 46 INC SI + 177 00E1 WRTVAL: + 178 00E1 AC LODSB + 179 00E2 0A C0 OR AL,AL + 180 00E4 74 05 JZ WRTTST + 181 00E6 E8 0000 E CALL $$WCH + 182 00E9 EB F6 JMP WRTVAL + 183 00EB WRTTST: + 184 00EB B0 2C MOV AL,"," + 185 00ED EB 9C JMP CHKEND + 186 + 187 00EF CMA: + 188 00EF E8 0000 E CALL $$POS + 189 00F2 8A C4 MOV AL,AH + 190 00F4 B4 00 MOV AH,0 + 191 00F6 B1 0E MOV CL,CLMWID + 192 00F8 F6 F1 DIV CL ;Remainder is position in this column + 193 00FA 2A CC SUB CL,AH ;Amount left in this column + 194 00FC 8A C1 MOV AL,CL + 195 00FE 98 CBW ;Amount to print is 16-bit number + 196 00FF 05 000E ADD AX,CLMWID ;Account for width of next column + 197 0102 E8 0113 R CALL PRTCHK ;Will another column fit? + 198 0105 2D 000E SUB AX,CLMWID + 199 0108 76 2B JBE RET + 200 010A 91 XCHG AX,CX + 201 010B TAB: + 202 010B B0 20 MOV AL," " + 203 010D E8 0000 E CALL $$WCH + 204 0110 E2 F9 LOOP TAB + 205 0112 C3 RET + 206 + 207 + 208 0113 PRTCHK: + 209 ;Check for enough space remaining on line to print AX characters. If not + 210 ;enough, start new line. + 211 + 212 0113 50 PUSH AX + 213 0114 E8 0000 E CALL $$WID + 214 0117 8A EC MOV CH,AH + 215 0119 80 FD FF CMP CH,255 + 216 011C 58 POP AX + + +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Page 1-5 + + + + 217 011D 74 16 JZ RET + 218 011F 0A E4 OR AH,AH ;More than 255 char to print? + 219 0121 75 0D JNZ FORCE + 220 0123 50 PUSH AX + 221 0124 E8 0000 E CALL $$POS + 222 0127 2A EC SUB CH,AH ;Amount left on line + 223 0129 58 POP AX + 224 012A 72 04 JB FORCE ;If no room on line, need new line + 225 012C 3A C5 CMP AL,CH ;Will amount requested fit? + 226 012E 76 05 JBE RET + 227 0130 FORCE: + 228 0130 E8 0000 E CALL $$WCLF ;Force the CR/LF + 229 0133 33 C0 XOR AX,AX + 230 0135 C3 RET: RET + 231 + 232 0136 CODE ENDS + 233 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0136 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0004 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +CHKEND . . . . . . . . . . . . . L NEAR 008B CODE +CLMWID . . . . . . . . . . . . . Number 000E +CMA. . . . . . . . . . . . . . . L NEAR 00EF CODE +COMMA. . . . . . . . . . . . . . Number 0000 +CRLF . . . . . . . . . . . . . . Number 0002 +CURTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +DBL. . . . . . . . . . . . . . . Number 0008 +ENDLIN . . . . . . . . . . . . . L NEAR 0094 CODE +FORCE. . . . . . . . . . . . . . L NEAR 0130 CODE +INT. . . . . . . . . . . . . . . Number 0002 +PRINT. . . . . . . . . . . . . . L NEAR 003C CODE +PRTCHK . . . . . . . . . . . . . L NEAR 0113 CODE +PRVAL. . . . . . . . . . . . . . L NEAR 007F CODE +PSTRG. . . . . . . . . . . . . . L NEAR 00A6 CODE +PUEN . . . . . . . . . . . . . . L NEAR 009A CODE +RET. . . . . . . . . . . . . . . L NEAR 0135 CODE +SEMI . . . . . . . . . . . . . . Number 0001 +SNGL . . . . . . . . . . . . . . Number 0004 +STOINT . . . . . . . . . . . . . L NEAR 0064 CODE +STREND . . . . . . . . . . . . . L NEAR 0092 CODE +STRING . . . . . . . . . . . . . Number 0003 +TAB. . . . . . . . . . . . . . . L NEAR 010B CODE +TSTPRUS. . . . . . . . . . . . . L NEAR 0068 CODE +TYP. . . . . . . . . . . . . . . V WORD 0000 DATA External +VALTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +WRTJMP . . . . . . . . . . . . . L NEAR 0097 CODE +WRTSPC . . . . . . . . . . . . . L NEAR 0089 CODE +WRTSTR . . . . . . . . . . . . . L NEAR 00C9 CODE +WRTTST . . . . . . . . . . . . . L NEAR 00EB CODE +WRTVAL . . . . . . . . . . . . . L NEAR 00E1 CODE +WRVAL. . . . . . . . . . . . . . L NEAR 00DB CODE +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External +$$POS. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$PUEN . . . . . . . . . . . . . L WORD 0002 DATA Global +$$PUFL . . . . . . . . . . . . . L BYTE 0001 DATA Global +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$WCH. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WCLF . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WID. . . . . . . . . . . . . . L NEAR 0000 CODE External +$$WRFL . . . . . . . . . . . . . L BYTE 0000 DATA Global +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External + + +PRNVAL - Print values Macro-86 %1(12) 1:7:5 13-Nov-81 Symbols-2 + + + +$FOUT. . . . . . . . . . . . . . L NEAR 0000 CODE External +$PV0A. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$PV0B. . . . . . . . . . . . . . L NEAR 0005 CODE Global +$PV0C. . . . . . . . . . . . . . L NEAR 000A CODE Global +$PV0D. . . . . . . . . . . . . . L NEAR 000F CODE Global +$PV1A. . . . . . . . . . . . . . L NEAR 0014 CODE Global +$PV1B. . . . . . . . . . . . . . L NEAR 0019 CODE Global +$PV1C. . . . . . . . . . . . . . L NEAR 001E CODE Global +$PV1D. . . . . . . . . . . . . . L NEAR 0023 CODE Global +$PV2A. . . . . . . . . . . . . . L NEAR 0028 CODE Global +$PV2B. . . . . . . . . . . . . . L NEAR 002D CODE Global +$PV2C. . . . . . . . . . . . . . L NEAR 0032 CODE Global +$PV2D. . . . . . . . . . . . . . L NEAR 0037 CODE Global +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$TYPSTR. . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/PRNVAL.ASM b/3_source_code/BASLIB-86/PRNVAL.ASM new file mode 100644 index 0000000..5a1af0c --- /dev/null +++ b/3_source_code/BASLIB-86/PRNVAL.ASM @@ -0,0 +1,233 @@ + TITLE PRNVAL - Print values + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC $$WRFL,$$PUFL,$$PUEN + + EXTRN $$SPSV:WORD,$FAC:BYTE,$AC:WORD + EXTRN TYP:WORD,VALTYP:BYTE,CURTYP:BYTE + +$$WRFL DB ? +$$PUFL DB ? +$$PUEN DW ? + +DATA ENDS + +DC GROUP DATA + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $PV0A,$PV0B,$PV0C,$PV0D + PUBLIC $PV1A,$PV1B,$PV1C,$PV1D + PUBLIC $PV2A,$PV2B,$PV2C,$PV2D + + EXTRN $$WCH:NEAR,$$WCLF:NEAR,$$DITS:NEAR,$FOUT:NEAR + EXTRN $TYPSTR:NEAR,$SAVREG:NEAR + EXTRN $$POS:NEAR,$$WID:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** PVnx - Print values +; +; n = 0 - follow with "," processing +; 1 - follow with ";" processing +; 2 - follow with CR/LF +; +; x = A - Single precision (pointer to value in BX) +; B - Double precision (pointer to value in BX) +; C - Integer (value in BX) +; D - String (Address of descriptor in BX) + +CLMWID EQU 14 +SNGL EQU 4 +DBL EQU 8 +INT EQU 2 +STRING EQU 3 +COMMA EQU 0 +SEMI EQU 1 +CRLF EQU 2 + +$PV0A: + CALL PRINT + DB SNGL,COMMA + +$PV0B: + CALL PRINT + DB DBL,COMMA + +$PV0C: + CALL PRINT + DB INT,COMMA + +$PV0D: + CALL PRINT + DB STRING,COMMA + +$PV1A: + CALL PRINT + DB SNGL,SEMI + +$PV1B: + CALL PRINT + DB DBL,SEMI + +$PV1C: + CALL PRINT + DB INT,SEMI + +$PV1D: + CALL PRINT + DB STRING,SEMI + +$PV2A: + CALL PRINT + DB SNGL,CRLF + +$PV2B: + CALL PRINT + DB DBL,CRLF + +$PV2C: + CALL PRINT + DB INT,CRLF + +$PV2D: + CALL PRINT + DB STRING,CRLF + +PRINT: + POP [TYP] ;Get pointer to flags + CALL $SAVREG + MOV SI,[TYP] + LODS WORD PTR CS:[SI] + MOV [TYP],AX ;Set VALTYP and CURTYP flags + CMP AL,STRING + JZ PSTRG ;Handle strings separately + CMP AL,INT + JZ STOINT + CBW + MOV SI,BX + MOV DI,OFFSET DC:$FAC+1 + SUB DI,AX ;Point to DAC or AC, as appropriate + MOV CX,AX + SHR CX,1 ;Move by words + REP MOVSW ;Number to print in FAC + JMP SHORT TSTPRUS +STOINT: + MOV [$AC],BX ;Number to print in FAC +TSTPRUS: + CMP [$$PUFL],0 ;Print using on? + JNZ PUEN ;Yes--go do it + CALL $FOUT ;Convert it to ASCII + CMP [$$WRFL],0 ;WRITE statement? + JNZ WRVAL ;Yes--handle special + INC AX ;Add 1 for the following space + MOV CL,0 ;Not special comma test + CALL PRTCHK ;Make it fit on line (give CR/LF if necessary) +PRVAL: + LODSB + OR AL,AL ;End of string? + JZ WRTSPC + CALL $$WCH ;Write character + JMP PRVAL +WRTSPC: + MOV AL," " +CHKEND: + CMP [CURTYP],SEMI ;What do we finish with? + JZ WRTJMP +STREND: + JB CMA ;Comma processing? +ENDLIN: JMP $$WCLF + +WRTJMP: JMP $$WCH + +PUEN: CALL [$$PUEN] + CMP [CURTYP],CRLF + JZ ENDLIN + RET + +PSTRG: + CMP [$$PUFL],0 ;Check for PRINT USING + JNZ PUEN + CMP [$$WRFL],0 ;WRITE? + JNZ WRTSTR + MOV AX,[BX] ;Get length in AX + MOV CL,0 ;No special comma test + CALL PRTCHK ;Try to make it fit on the line + CALL $TYPSTR ;Output the string + CALL $$DITS ;Delete it if temporary string + CMP [CURTYP],SEMI ;What do we finish with? + JNZ STREND + RET + +WRTSTR: + MOV AL,'"' + CALL $$WCH + CALL $TYPSTR + CALL $$DITS + MOV AL,'"' + CALL $$WCH + JMP SHORT WRTTST + +WRVAL: + CMP BYTE PTR[SI]," " ;Is first letter a blank? + JNZ WRTVAL + INC SI +WRTVAL: + LODSB + OR AL,AL + JZ WRTTST + CALL $$WCH + JMP WRTVAL +WRTTST: + MOV AL,"," + JMP CHKEND + +CMA: + CALL $$POS + MOV AL,AH + MOV AH,0 + MOV CL,CLMWID + DIV CL ;Remainder is position in this column + SUB CL,AH ;Amount left in this column + MOV AL,CL + CBW ;Amount to print is 16-bit number + ADD AX,CLMWID ;Account for width of next column + CALL PRTCHK ;Will another column fit? + SUB AX,CLMWID + JBE RET + XCHG AX,CX +TAB: + MOV AL," " + CALL $$WCH + LOOP TAB + RET + + +PRTCHK: +;Check for enough space remaining on line to print AX characters. If not +;enough, start new line. + + PUSH AX + CALL $$WID + MOV CH,AH + CMP CH,255 + POP AX + JZ RET + OR AH,AH ;More than 255 char to print? + JNZ FORCE + PUSH AX + CALL $$POS + SUB CH,AH ;Amount left on line + POP AX + JB FORCE ;If no room on line, need new line + CMP AL,CH ;Will amount requested fit? + JBE RET +FORCE: + CALL $$WCLF ;Force the CR/LF + XOR AX,AX +RET: RET + +CODE ENDS + END From 90566f68569d18cc047c487f8e5a4343605e5374 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Wed, 5 Aug 2026 13:18:16 -0700 Subject: [PATCH 50/53] Removed formatting remnants accidentally left in source code --- 2_printed_files/bundle_09/IOFILM.ASM | 2 +- 2_printed_files/bundle_09/LININP.ASM | 2 +- 2_printed_files/bundle_09/MID.ASM | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/2_printed_files/bundle_09/IOFILM.ASM b/2_printed_files/bundle_09/IOFILM.ASM index 76b4f0f..ed2ddb8 100644 --- a/2_printed_files/bundle_09/IOFILM.ASM +++ b/2_printed_files/bundle_09/IOFILM.ASM @@ -3,7 +3,7 @@ IOFILM - File Manager for BASCOM-86 Macro-86 %1(12) 1:5:1 1 TITLE IOFILM - File Manager for BASCOM-86 - 2 PAGE 60,132 + 2 3 ; This module contains the dynamic file management routines for the 4 ; 8086 BASIC Compiler runtime. 5 diff --git a/2_printed_files/bundle_09/LININP.ASM b/2_printed_files/bundle_09/LININP.ASM index 74e5b35..71eb927 100644 --- a/2_printed_files/bundle_09/LININP.ASM +++ b/2_printed_files/bundle_09/LININP.ASM @@ -3,7 +3,7 @@ LININP - LINE INPUT statement Macro-86 %1(12) 1:6:2 1 TITLE LININP - LINE INPUT statement - 2 PAGE 60,132 + 2 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' 4 5 EXTRN $FILBUF:WORD,$INBUF:BYTE,$$ERRV:WORD diff --git a/2_printed_files/bundle_09/MID.ASM b/2_printed_files/bundle_09/MID.ASM index 467d7a8..14e6259 100644 --- a/2_printed_files/bundle_09/MID.ASM +++ b/2_printed_files/bundle_09/MID.ASM @@ -3,7 +3,7 @@ MID - Left-hand MID$ Macro-86 %1(12) 1:6:1 1 TITLE MID - Left-hand MID$ - 2 PAGE 60,132 + 2 3 0000 CODE SEGMENT BYTE PUBLIC 'CODE' 4 5 PUBLIC $MD$A From 70525ebbf204f519a6a5e5df5984cf02c83c7f18 Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Thu, 6 Aug 2026 15:30:11 -0700 Subject: [PATCH 51/53] Transcription of Bundle 9 - PRTU.ASM Code and Listing --- 2_printed_files/bundle_09/PRTU.ASM | 540 +++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/PRTU.ASM | 354 +++++++++++++++++++ 2 files changed, 894 insertions(+) create mode 100644 2_printed_files/bundle_09/PRTU.ASM create mode 100644 3_source_code/BASLIB-86/PRTU.ASM diff --git a/2_printed_files/bundle_09/PRTU.ASM b/2_printed_files/bundle_09/PRTU.ASM new file mode 100644 index 0000000..ddfbb08 --- /dev/null +++ b/2_printed_files/bundle_09/PRTU.ASM @@ -0,0 +1,540 @@ +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-1 + + + + 1 TITLE PRTU - PRINT USING Driver + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 PUBLIC $PUFLAG, $DIGCNT + 6 + 7 EXTRN $$SPSV:WORD,VALTYP:BYTE,$$PUFL:BYTE,$$PUEN:WORD + 8 + 9 0000 ???? ???? PUDS DW ?,? ;Print Using string descriptor + 10 0004 ???? PUSC DW ? ;PRINT USING SCAN COUNT + 11 0006 ???? $DIGCNT DW ? ;Count of digits before and after d.p. + 12 0008 ?? PUVS DB ? ;PRINT USING VALUE SEEN FLAG + 13 0009 $PUFLAG LABEL BYTE + 14 0009 ?? FLAG DB ? ;Flag byte + 15 ;Bits of the flag byte are used as follows: + 16 ; 0 0=Fixed format, 1=Scientific notation + 17 ; 1 0=Print number, 1=Print string + 18 ; 2 1=Place sign after number + 19 ; 3 1=Print "+" for positive numbers + 20 ; 4 1=Print "$" in front of number + 21 ; 5 0=Pad with leading spaces; 1=Pad with leading "*" + 22 ; 6 1=Put commas every three digits + 23 ; 7 0=Free format output, 1=Print using output + 24 + 25 000A DATA ENDS + 26 + 27 + 28 DC GROUP DATA + 29 + 30 + 31 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 32 + 33 PUBLIC $PRU + 34 + 35 EXTRN $$WCH:NEAR,$ERC_FC:NEAR,$ERC_TM:NEAR + 36 EXTRN $$DITS:NEAR,$SAS:FAR,$SAVREG:NEAR + 37 EXTRN $PUFOUT:NEAR,$TYPCNT:NEAR,$OUTCNT:NEAR + 38 + 39 ASSUME CS:CODE, DS:DC, ES:DC + 40 + 41 = 0024 CURNCY= "$" ;Currency symbol + 42 = 005C CSTRNG= "\" ;String USING symbol + 43 + 44 = 0000 SD_LEN= 0 ;STRING DESCRIPTOR LENGTH OFFSET + 45 = 0002 SD_ADR= 2 ;STRING DESCRIPTOR ADDRESS OFFSET + 46 + 47 + 48 ; ENTRY (HL) = Pointer to using SDESC + 49 + 50 + 51 0000 $PRU PROC FAR + 52 0000 89 26 0000 E MOV $$SPSV,SP ;Save SP in case of error in SAS + 53 0004 52 PUSH DX + 54 0005 BA 0000 R MOV DX,OFFSET DC:PUDS ;Point to the destination descriptor + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-2 + + + + 55 0008 9A 0000 ---- E CALL $SAS ;** 5.2 ** Copy "using" string + 56 000D 5A POP DX + 57 000E C6 06 0000 E 01 MOV $$PUFL,1 ;SET PRINT USING FLAG + 58 0013 C7 06 0000 E 0022 R MOV $$PUEN,OFFSET $$PREN ;SET PRINT ITEM ENTRY ADDRESS + 59 0019 32 C0 XOR AL,AL ;ZERO VALUE SEEN FLAG + 60 001B A2 0008 R MOV PUVS,AL + 61 001E A2 0009 R MOV FLAG,AL ;SET TO NO TYPE PENDING + 62 0021 CB RET + 63 0022 $PRU ENDP + 64 + 65 + 66 ; Entry point for printing numbers and strings + 67 + 68 0022 $$PREN: + 69 0022 A0 0009 R MOV AL,FLAG ;TEST IF TYPE PENDING + 70 0025 0A C0 OR AL,AL + 71 0027 75 08 JNZ PREN01 ;YES - PROCESS AS NORMAL + 72 0029 53 PUSH BX ;Save possible string descriptor + 73 002A E8 0072 R CALL PUINIT ;ZERO - SCAN STARTING AT BEGINNING + 74 002D 5B POP BX + 75 002E A0 0009 R MOV AL,FLAG + 76 0031 PREN01: + 77 0031 A2 0008 R MOV PUVS,AL ;Must have found a value + 78 0034 8B 0E 0006 R MOV CX,$DIGCNT ;LOAD [CH,CL] + 79 0038 A8 02 TEST AL,2 ;Does the field define a string? + 80 003A 75 10 JNZ PUSTR ;PRINT STRING + 81 003C 80 3E 0000 E 03 CMP VALTYP,3 ;IS IT A STRING? + 82 0041 74 54 JZ TMER ;ERROR - TYPE MISMATCH + 83 0043 E8 0000 E CALL $PUFOUT ;FORMAT NUMBER + 84 0046 91 XCHG AX,CX ;Put count in CX + 85 0047 E8 0000 E CALL $OUTCNT + 86 004A EB 30 JMP SHORT PUSCAN + 87 + 88 004C PUSTR: + 89 004C 80 3E 0000 E 03 CMP VALTYP,3 ;Type better be string + 90 0051 75 44 JNZ TMER ;ERROR - TYPE MISMATCH + 91 0053 8B D1 MOV DX,CX ;Put length of print field into DX + 92 0055 8B 0F MOV CX,[BX] ;Get length of string + 93 0057 2B D1 SUB DX,CX ;DX = Padding count + 94 ;Note that if we have a variable length string field, DX will be -1. + 95 ;The result of the above subtraction will never carry (so we will take the + 96 ;JAE below), but the number left in DX will always be negative. Thus when + 97 ;we get to the padding check, no blanks will be added. + 98 0059 73 02 JAE PRSTR ;If field is big enough, proceed + 99 005B 03 CA ADD CX,DX ;CX = CX + (DX-CX) = DX + 100 005D PRSTR: + 101 005D E8 0000 E CALL $TYPCNT ;Output CX bytes of string + 102 0060 E8 0000 E CALL $$DITS ;DELETE IF TEMPORARY STRING + 103 0063 8B CA MOV CX,DX ;Padding count + 104 0065 0B C9 OR CX,CX + 105 0067 7E 13 JLE PUSCAN ;Any padding needed? + 106 0069 B0 20 MOV AL," " ;PAD OUT REMAINDER OF FIELD + 107 006B PUPAD: + 108 006B E8 0000 E CALL $$WCH ;PRINT SPACE + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-3 + + + + 109 006E E2 FB LOOP PUPAD ; CONTINUE PADDING + 110 0070 EB 0A JMP SHORT PUSCAN + 111 + 112 0072 PUINIT: + 113 0072 A1 0000 R MOV AX,PUDS+SD_LEN ;Get length of PRINT USING string + 114 0075 A3 0004 R MOV PUSC,AX ;SAVE SCAN COUNT REMAINING + 115 0078 0B C0 OR AX,AX ;Null string? + 116 007A 74 18 JZ FARG ;If so, illegal function call + 117 007C PUSCAN: + 118 007C C6 06 0009 R 00 MOV FLAG,0 + 119 0081 8B 36 0002 R MOV SI,PUDS+SD_ADR ;Start of string (could change if G.C.!) + 120 0085 A1 0000 R MOV AX,PUDS+SD_LEN + 121 0088 8B 0E 0004 R MOV CX,PUSC ;Get scan count + 122 008C 2B C1 SUB AX,CX ;Offset into string + 123 008E 03 F0 ADD SI,AX + 124 0090 E3 1C JCXZ RET ;At end of string? + 125 0092 EB 58 JMP SHORT PRCCHR ;If not, scan for next value (or EOS) + 126 + 127 0094 E9 0000 E FARG: JMP $ERC_FC ;Illegal function call + 128 + 129 0097 E9 0000 E TMER: JMP $ERC_TM ;Type mismatch + 130 + 131 009A E8 01BF R REUSIN: CALL PLSPRT ;PRINT A "+" IF NECESSARY + 132 009D E8 0000 E CALL $$WCH + 133 00A0 REUSN1: + 134 00A0 89 0E 0004 R MOV PUSC,CX ;Save scan count ( = 0 ) + 135 00A4 88 0E 0009 R MOV FLAG,CL ;SET NO TYPE PENDING + 136 00A8 3A 0E 0008 R CMP CL,PUVS ;Any values seen in string? + 137 00AC 74 E6 JZ FARG ;If not, we'll never get anywhere + 138 00AE C3 RET: RET + 139 + 140 ; HERE TO HANDLE A LITERAL CHARACTER IN THE USING STRING PRECEDED + 141 ; BY "_" + 142 ; + 143 00AF E8 01BF R LITCHR: CALL PLSPRT ;PRINT PREVIOUS "+" IF ANY + 144 00B2 AC LODSB ;FETCH LITERAL CHARACTER + 145 00B3 E8 0000 E CALL $$WCH ;OUTPUT LITERAL CHARACTER + 146 00B6 E2 34 LOOP PRCCHR ;DECREMENT COUNT FOR ACTUAL CHARACTER + 147 00B8 EB E6 JMP SHORT REUSN1 + 148 + 149 ; HERE TO HANDLE VARIABLE LENGTH STRING FIELD SPECIFIED WITH "&" + 150 ; + 151 00BA VARSTR: + 152 00BA BB FFFF MOV BX,-1 ;SET LENGTH TO MAXIMUM POSSIBLE + 153 00BD ISSTRF: + 154 00BD 49 DEC CX ;DECREMENT THE "USING" STRING CHARACTER COUNT + 155 00BE E8 01BF R CALL PLSPRT ;PRINT A "+" IF ONE CAME BEFORE THE FIELD + 156 00C1 89 0E 0004 R MOV PUSC,CX ;Save scan count + 157 00C5 89 1E 0006 R MOV $DIGCNT,BX ;Save field width + 158 00C9 C6 06 0009 R 02 MOV FLAG,2 ;Flag string type + 159 00CE C3 RET + 160 + 161 00CF 8B E9 BGSTRF: MOV BP,CX ;SAVE THE "USING" STRING CHARACTER COUNT + 162 00D1 8B FE MOV DI,SI ;SAVE THE POINTER INTO THE "USING" STRING + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-4 + + + + 163 00D3 BB 0002 MOV BX,2 ;THE \\ STRING FIELD HAS 2 PLUS + 164 ;NUMBER OF ENCLOSED SPACES WIDTH + 165 00D6 LPSTRF: + 166 00D6 AC LODSB ;GET THE NEXT CHARACTER + 167 00D7 3C 5C CMP AL,CSTRNG ;THE FIELD TERMINATOR? + 168 00D9 74 E2 JZ ISSTRF ;GO EVALUATE A STRING AND PRINT + 169 00DB 43 INC BX ;INCREMENT THE FIELD WIDTH + 170 00DC 3C 20 CMP AL," " ;A FIELD EXTENDER? + 171 00DE E1 F6 LOOPZ LPSTRF ;KEEP SCANNING FOR THE FIELD TERMINATOR + 172 + 173 ; SINCE STRING FIELD WASN'T FOUND, THE "USING" STRING + 174 ; CHARACTER COUNT AND THE POINTER INTO IT'S DATA MUST + 175 ; BE RESTORED AND THE "\" PRINTED + 176 ; + 177 00E0 8B F7 NOSTRF: MOV SI,DI ;RESTORE THE POINTER INTO "USING" STRING'S DATA + 178 00E2 8B CD MOV CX,BP + 179 00E4 B0 5C MOV AL,CSTRNG ;RESTORE THE CHARACTER + 180 ; + 181 ; HERE TO PRINT THE CHARACTER IN [AL] SINCE IT WASN'T PART OF ANY FIELD + 182 ; + 183 00E6 E8 01BF R NEWUCH: CALL PLSPRT ;IF A "+" CAME BEFORE THIS CHARACTER + 184 ;MAKE SURE IT GETS PRINTED + 185 00E9 E8 0000 E CALL $$WCH ;PRINT THE CHARACTER THAT WASN'T + 186 ;PART OF A FIELD + 187 + 188 ;Here is the entry point to start scanning for the next value field. + 189 ;Register usage: + 190 ; SI Points to next byte in PRINT USING string + 191 ; CX Count of characters left in PRINT USING string + 192 ; DH Flag byte used by $PUFOUT (stored in FLAG - see above) + 193 ; BH Number of digits to left of decimal point (numbers only) + 194 ; BL Number of digits to right of decimal point (numbers only) + 195 ; BX Length of string field (strings only) + 196 + 197 00EC 32 C0 PRCCHR: XOR AL,AL ;SET [DH]=0 SO IF WE DISPATCH + 198 00EE 8A F0 MOV DH,AL ;DON'T PRINT "+" TWICE + 199 00F0 E8 01BF R PLSFIN: CALL PLSPRT ;ALLOW FOR MULTIPLE PLUSES + 200 ;IN A ROW + 201 00F3 8A F0 MOV DH,AL ;SET "+" FLAG + 202 00F5 AC LODSB ;GET A NEW CHARACTER + 203 00F6 3C 21 CMP AL,"!" ;CHECK FOR A SINGLE CHARACTER + 204 00F8 BB 0001 MOV BX,1 ;Set string length to 1 + 205 00FB 74 C0 JZ ISSTRF ;STRING FIELD + 206 00FD 3C 23 CMP AL,"#" ;CHECK FOR THE START OF A NUMBERIC FIELD + 207 00FF 74 40 JZ NUMNUM ;GO SCAN IT + 208 0101 3C 26 CMP AL,"&" ;See if variable string field + 209 0103 74 B5 JZ VARSTR ;GO PRINT ENTIRE STRING + 210 0105 49 DEC CX ;ALL THE OTHER POSSIBILITIES + 211 ;REQUIRE AT LEAST 2 CHARACTERS + 212 0106 74 92 JZ REUSIN ;IF THE VALUE LIST IS NOT EXHAUSTED + 213 ;GO REUSE "USING" STRING + 214 0108 3C 2B CMP AL,"+" ;A LEADING "+" ? + 215 010A B0 08 MOV AL,8 ;SET [DH] WITH THE PLUS-FLAG ON IN + 216 010C 74 E2 JZ PLSFIN ;CASE A NUMERIC FIELD STARTS + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-5 + + + + 217 010E 8A 44 FF MOV AL,[SI-1] ;GET BACK THE CURRENT CHARACTER + 218 0111 3C 2E CMP AL,"." ;NUMERIC FIELD WITH TRAILING DIGITS + 219 0113 74 45 JZ DOTNUM ;IF SO GO SCAN WITH [BH]= + 220 ;NUMBER OF DIGITS BEFORE THE "."=0 + 221 0115 3C 5F CMP AL,"_" ;CHECK FOR LITERAL CHARACTER DECLARATION + 222 0117 74 96 JZ LITCHR + 223 0119 3C 5C CMP AL,CSTRNG ;CHECK FOR A BIG STRING FIELD STARTER + 224 011B 74 B2 JZ BGSTRF ;GO SEE IF IT REALLY IS A STRING FIELD + 225 011D 3A 04 CMP AL,[SI] ;SEE IF THE NEXT CHARACTER MATCHES THE + 226 ;CURRENT ONE + 227 011F 75 C5 JNZ NEWUCH ;IF NOT, CAN'T HAVE $$ OR ** SO ALL THE + 228 ;POSSIBILITIES ARE EXHAUSTED + 229 0121 3C 24 CMP AL,CURNCY ;IS IT $$ ? + 230 0123 74 16 JZ DOLRNM ;GO SET UP THE FLAG BIT + 231 0125 3C 2A CMP AL,"*" ;IS IT ** ? + 232 0127 75 BD JNZ NEWUCH ;IF NOT, ITS NOT PART + 233 ;OF A FIELD SINCE ALL THE POSSIBILITIES + 234 ;HAVE BEEN TRIED + 235 0129 80 CE 20 OR DH,32 ;Set "*" bit + 236 012C 46 INC SI + 237 012D 83 F9 02 CMP CX,2 ;SEE IF THE "USING" STRING IS LONG + 238 ;ENOUGH FOR THE SPECIAL CASE OF + 239 0130 72 0D JC SPCNUM ; **$ + 240 0132 8A 04 MOV AL,[SI] + 241 0134 3C 24 CMP AL,CURNCY ;IS THE NEXT CHARACTER $ ? + 242 0136 75 07 JNZ SPCNUM ;IF IT NOT THE SPECIAL CASE, DON'T + 243 ;SET THE DOLLAR SIGN FLAG + 244 0138 49 DEC CX ;DECREMENT THE "USING" STRING CHARACTER COUNT + 245 ;TO TAKE THE $ INTO CONSIDERATION + 246 0139 FE C7 INC BH ;INCREMENT THE FIELD WIDTH FOR THE + 247 ;FLOATING DOLLAR SIGN + 248 013B DOLRNM: + 249 013B 80 CE 10 OR DH,16 ;SET BIT FOR FLOATING DOLLAR SIGN FLAG + 250 013E 46 INC SI ;POINT BEYOND THE SPECIAL CHARACTERS + 251 013F FE C7 SPCNUM: INC BH ;SINCE TWO CHARACTERS SPECIFY + 252 ;THE FIELD SIZE, INITIALIZE [BH]=1 + 253 0141 FE C7 NUMNUM: INC BH ;INCREMENT THE NUMBER OF DIGITS BEFORE + 254 ;THE DECIMAL POINT + 255 0143 B3 00 MOV BL,0 ;SET THE NUMBER OF DIGITS AFTER + 256 ;THE DECIMAL POINT = 0 + 257 0145 49 DEC CX ;SEE IF THERE ARE MORE CHARACTERS + 258 0146 74 42 JZ NOTSCI ;IF NOT, WE ARE DONE SCANNING THIS + 259 ;NUMERIC FIELD + 260 0148 AC LODSB ;GET THE NEW CHARACTER + 261 0149 3C 2E CMP AL,"." ;DO WE HAVE TRAILING DIGITS? + 262 014B 74 18 JZ AFTDOT ;IF SO, USE SPECIAL SCAN LOOP + 263 014D 3C 23 CMP AL,"#" ;MORE LEADING DIGITS ? + 264 014F 74 F0 JZ NUMNUM ;INCREMENT THE COUNT AND KEEP SCANNING + 265 0151 3C 2C CMP AL,"," ;DOES HE WANT A COMMA + 266 ;EVERY THREE DIGITS? + 267 0153 75 1A JNZ FINNUM ;NO MORE LEADING DIGITS, CHECK FOR ^^^ + 268 0155 80 CE 40 OR DH,64 ;TURN ON THE COMMA BIT + 269 0158 EB E7 JMP NUMNUM ;GO SCAN SOME MORE + 270 ; + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-6 + + + + 271 ; HERE WHEN A "." IS SEEN IN THE "USING" STRING + 272 ; IT STARTS A NUMERIC FIELD IF AND ONLY IF + 273 ; IT IS FOLLOWED BY A "#" + 274 ; + 275 015A 8A 04 DOTNUM: MOV AL,[SI] ;GET THE CHARACTER THAT FOLLOWS + 276 015C 3C 23 CMP AL,"#" ;IS THIS A NUMERIC FIELD? + 277 015E B0 2E MOV AL,"." ;IF NOT, GO BACK AND PRINT "." + 278 0160 75 84 JNZ NEWUCH + 279 0162 B3 01 MOV BL,1 ;INITIALIZE THE NUMBER OF + 280 ;DIGITS AFTER THE DECIMAL POINT + 281 0164 46 INC SI + 282 0165 FE C3 AFTDOT: INC BL ;INCREMENT THE NUMBER OF DIGITS + 283 ;AFTER THE DECIMAL POINT + 284 0167 49 DEC CX ;SEE IF THE "USING" STRING HAS MORE + 285 0168 74 20 JZ NOTSCI ;CHARACTERS, AND IF NOT, STOP SCANNING + 286 016A AC LODSB ;GET THE NEXT CHARACTER + 287 016B 3C 23 CMP AL,"#" ;MORE DIGITS AFTER THE DECIMAL POINT? + 288 016D 74 F6 JZ AFTDOT ;IF SO, INCREMENT THE COUNT AND KEEP + 289 ;SCANNING + 290 ; + 291 ; CHECK FOR THE "^^^^" THAT INDICATES SCIENTIFIC NOTATION + 292 ; + 293 016F FINNUM: + 294 016F 4E DEC SI ;Point back to current character + 295 0170 81 3C 5E5E CMP WORD PTR [SI],"^^" ;Two "^"s in a row? + 296 0174 75 14 JNZ NOTSCI + 297 0176 81 7C 02 5E5E CMP WORD PTR [SI+2],"^^" ;Four "^"s in a row? + 298 017B 75 0D JNZ NOTSCI + 299 017D 83 F9 04 CMP CX,4 ;WERE THERE ENOUGH CHARACTERS FOR "^^^^"? + 300 0180 72 48 JC RT + 301 0182 83 E9 04 SUB CX,4 + 302 0185 83 C6 04 ADD SI,4 + 303 0188 FE C6 INC DH ;TURN ON THE SCIENTIFIC NOTATION FLAG + 304 018A NOTSCI: + 305 018A FE C7 INC BH ;INCLUDE LEADING "+" IN NUMBER OF DIGITS + 306 018C F6 C6 08 TEST DH,8 ;DON'T CHECK FOR A TRAILING SIGN + 307 018F 75 14 JNZ ENDNUM ;ALL DONE WITH THE FIELD IF SO + 308 ;IF THERE IS A LEADING PLUS + 309 0191 FE CF DEC BH ;NO LEADING PLUS SO DON'T INCREMENT THE + 310 ;NUMBER OF DIGITS BEFORE THE DECIMAL POINT + 311 0193 E3 10 JCXZ ENDNUM ;SEE IF THERE ARE MORE CHARACTERS + 312 0195 AC LODSB ;GET THE CURRENT CHARACTER + 313 0196 3C 2D CMP AL,"-" ;TRAIL MINUS? + 314 0198 74 07 JZ SGNTRL ;SET THE TRAILING SIGN FLAG + 315 019A 3C 2D CMP AL,"-" ;A TRAILING PLUS? + 316 019C 75 07 JNZ ENDNUM ;IF NOT, WE ARE DONE SCANNING + 317 019E 80 CE 08 OR DH,8 ;TURN ON THE POSITIVE="+" FLAG + 318 01A1 80 CE 04 SGNTRL: OR DH,4 ;TURN ON THE TRAILING SIGN FLAG + 319 01A4 49 DEC CX ;DECREMENT THE "USING" STRING CHARACTER + 320 ;COUNT TO ACCOUNT FOR THE TRAILING SIGN + 321 01A5 ENDNUM: + 322 01A5 89 0E 0004 R MOV PUSC,CX ;Save scan count + 323 01A9 89 1E 0006 R MOV $DIGCNT,BX + 324 01AD 02 FB ADD BH,BL ;Digit count must not exceed 24 + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Page 1-7 + + + + 325 01AF 80 FF 19 CMP BH,25 + 326 01B2 73 08 JNC ARGERR ;IF SO, "ILLEGAL FUNCTION CALL" + 327 01B4 80 CE 80 OR DH,80H ;TURN ON THE "USING" BIT + 328 01B7 88 36 0009 R MOV FLAG,DH + 329 01BB C3 RET ;GET OUT + 330 + 331 01BC E9 0000 E ARGERR: JMP $ERC_FC + 332 + 333 ; WHEN A "+" IS DETECTED IN THE "USING" STRING + 334 ; IF A NUMERIC FIELD FOLLOWS A BIT IN [DH] SHOULD + 335 ; BE SET, OTHERWISE "+" SHOULD BE PRINTED. + 336 ; SINCE DECIDING WHETHER A NUMERIC FIELD FOLLOWS IS VERY + 337 ; DIFFICULT, THE BIT IS ALWAYS SET IN [DH]. + 338 ; AT THE POINT IT IS DECIDED A CHARACTER IS NOT PART + 339 ; OF A NUMERIC FIELD, THIS ROUTINE IS CALLED TO SEE + 340 ; IF THE BIT IN [DH] IS SET, WHICH MEANS + 341 ; A PLUS PRECEDED THE CHARACTER AND SHOULD BE + 342 ; PRINTED. + 343 ; + 344 01BF PLSPRT: + 345 01BF 0A F6 OR DH,DH ;CHECK THE PLUS BIT + 346 01C1 74 07 JZ RT + 347 01C3 50 PUSH AX ;SAVE THE CURRENT CHARACTER + 348 01C4 B0 2B MOV AL,"+" ;SETUP TO PRINT THE PLUS + 349 01C6 E8 0000 E CALL $$WCH ;PRINT IT IF THE BIT WAS SET + 350 01C9 58 POP AX ;GET BACK THE CURRENT CHARACTER + 351 01CA C3 RT: RET + 352 + 353 01CB CODE ENDS + 354 END + + + + + + + + + + + + + + + + + + + + + + + + + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 01CB BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 000A WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +AFTDOT . . . . . . . . . . . . . L NEAR 0165 CODE +ARGERR . . . . . . . . . . . . . L NEAR 01BC CODE +BGSTRF . . . . . . . . . . . . . L NEAR 00CF CODE +CSTRNG . . . . . . . . . . . . . Number 005C +CURNCY . . . . . . . . . . . . . Number 0024 +DOLRNM . . . . . . . . . . . . . L NEAR 013B CODE +DOTNUM . . . . . . . . . . . . . L NEAR 015A CODE +ENDNUM . . . . . . . . . . . . . L NEAR 01A5 CODE +FARG . . . . . . . . . . . . . . L NEAR 0094 CODE +FINNUM . . . . . . . . . . . . . L NEAR 016F CODE +FLAG . . . . . . . . . . . . . . L BYTE 0009 DATA +ISSTRF . . . . . . . . . . . . . L NEAR 00BD CODE +LITCHR . . . . . . . . . . . . . L NEAR 00AF CODE +LPSTRF . . . . . . . . . . . . . L NEAR 00D6 CODE +NEWUCH . . . . . . . . . . . . . L NEAR 00E6 CODE +NOSTRF . . . . . . . . . . . . . L NEAR 00E0 CODE +NOTSCI . . . . . . . . . . . . . L NEAR 018A CODE +NUMNUM . . . . . . . . . . . . . L NEAR 0141 CODE +PLSFIN . . . . . . . . . . . . . L NEAR 00F0 CODE +PLSPRT . . . . . . . . . . . . . L NEAR 01BF CODE +PRCCHR . . . . . . . . . . . . . L NEAR 00EC CODE +PREN01 . . . . . . . . . . . . . L NEAR 0031 CODE +PRSTR. . . . . . . . . . . . . . L NEAR 005D CODE +PUDS . . . . . . . . . . . . . . L WORD 0000 DATA +PUINIT . . . . . . . . . . . . . L NEAR 0072 CODE +PUPAD. . . . . . . . . . . . . . L NEAR 006B CODE +PUSC . . . . . . . . . . . . . . L WORD 0004 DATA +PUSCAN . . . . . . . . . . . . . L NEAR 007C CODE +PUSTR. . . . . . . . . . . . . . L NEAR 004C CODE +PUVS . . . . . . . . . . . . . . L BYTE 0008 DATA +RET. . . . . . . . . . . . . . . L NEAR 00AE CODE +REUSIN . . . . . . . . . . . . . L NEAR 009A CODE +REUSN1 . . . . . . . . . . . . . L NEAR 00A0 CODE +RT . . . . . . . . . . . . . . . L NEAR 01CA CODE +SD_ADR . . . . . . . . . . . . . Number 0002 +SD_LEN . . . . . . . . . . . . . Number 0000 +SGNTRL . . . . . . . . . . . . . L NEAR 01A1 CODE +SPCNUM . . . . . . . . . . . . . L NEAR 013F CODE +TMER . . . . . . . . . . . . . . L NEAR 0097 CODE +VALTYP . . . . . . . . . . . . . V BYTE 0000 DATA External +VARSTR . . . . . . . . . . . . . L NEAR 00BA CODE +$$DITS . . . . . . . . . . . . . L NEAR 0000 CODE External + + +PRTU - PRINT USING Driver Macro-86 %1(12) 1:7:14 13-Nov-81 Symbols-2 + + + +$$PREN . . . . . . . . . . . . . L NEAR 0022 CODE +$$PUEN . . . . . . . . . . . . . V WORD 0000 DATA External +$$PUFL . . . . . . . . . . . . . V BYTE 0000 DATA External +$$SPSV . . . . . . . . . . . . . V WORD 0000 DATA External +$$WCH. . . . . . . . . . . . . . L NEAR 0000 CODE External +$DIGCNT. . . . . . . . . . . . . L WORD 0006 DATA Global +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_TM. . . . . . . . . . . . . L NEAR 0000 CODE External +$OUTCNT. . . . . . . . . . . . . L NEAR 0000 CODE External +$PRU . . . . . . . . . . . . . . F PROC 0000 CODE Global Length =0022 +$PUFLAG. . . . . . . . . . . . . L BYTE 0009 DATA Global +$PUFOUT. . . . . . . . . . . . . L NEAR 0000 CODE External +$SAS . . . . . . . . . . . . . . L FAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$TYPCNT. . . . . . . . . . . . . L NEAR 0000 CODE External + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/PRTU.ASM b/3_source_code/BASLIB-86/PRTU.ASM new file mode 100644 index 0000000..f578327 --- /dev/null +++ b/3_source_code/BASLIB-86/PRTU.ASM @@ -0,0 +1,354 @@ + TITLE PRTU - PRINT USING Driver + +DATA SEGMENT WORD PUBLIC 'DATA' + + PUBLIC $PUFLAG, $DIGCNT + + EXTRN $$SPSV:WORD,VALTYP:BYTE,$$PUFL:BYTE,$$PUEN:WORD + +PUDS DW ?,? ;Print Using string descriptor +PUSC DW ? ;PRINT USING SCAN COUNT +$DIGCNT DW ? ;Count of digits before and after d.p. +PUVS DB ? ;PRINT USING VALUE SEEN FLAG +$PUFLAG LABEL BYTE +FLAG DB ? ;Flag byte +;Bits of the flag byte are used as follows: +; 0 0=Fixed format, 1=Scientific notation +; 1 0=Print number, 1=Print string +; 2 1=Place sign after number +; 3 1=Print "+" for positive numbers +; 4 1=Print "$" in front of number +; 5 0=Pad with leading spaces; 1=Pad with leading "*" +; 6 1=Put commas every three digits +; 7 0=Free format output, 1=Print using output + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $PRU + + EXTRN $$WCH:NEAR,$ERC_FC:NEAR,$ERC_TM:NEAR + EXTRN $$DITS:NEAR,$SAS:FAR,$SAVREG:NEAR + EXTRN $PUFOUT:NEAR,$TYPCNT:NEAR,$OUTCNT:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +CURNCY= "$" ;Currency symbol +CSTRNG= "\" ;String USING symbol + +SD_LEN= 0 ;STRING DESCRIPTOR LENGTH OFFSET +SD_ADR= 2 ;STRING DESCRIPTOR ADDRESS OFFSET + + +; ENTRY (HL) = Pointer to using SDESC + + +$PRU PROC FAR + MOV $$SPSV,SP ;Save SP in case of error in SAS + PUSH DX + MOV DX,OFFSET DC:PUDS ;Point to the destination descriptor + CALL $SAS ;** 5.2 ** Copy "using" string + POP DX + MOV $$PUFL,1 ;SET PRINT USING FLAG + MOV $$PUEN,OFFSET $$PREN ;SET PRINT ITEM ENTRY ADDRESS + XOR AL,AL ;ZERO VALUE SEEN FLAG + MOV PUVS,AL + MOV FLAG,AL ;SET TO NO TYPE PENDING + RET +$PRU ENDP + + +; Entry point for printing numbers and strings + +$$PREN: + MOV AL,FLAG ;TEST IF TYPE PENDING + OR AL,AL + JNZ PREN01 ;YES - PROCESS AS NORMAL + PUSH BX ;Save possible string descriptor + CALL PUINIT ;ZERO - SCAN STARTING AT BEGINNING + POP BX + MOV AL,FLAG +PREN01: + MOV PUVS,AL ;Must have found a value + MOV CX,$DIGCNT ;LOAD [CH,CL] + TEST AL,2 ;Does the field define a string? + JNZ PUSTR ;PRINT STRING + CMP VALTYP,3 ;IS IT A STRING? + JZ TMER ;ERROR - TYPE MISMATCH + CALL $PUFOUT ;FORMAT NUMBER + XCHG AX,CX ;Put count in CX + CALL $OUTCNT + JMP SHORT PUSCAN + +PUSTR: + CMP VALTYP,3 ;Type better be string + JNZ TMER ;ERROR - TYPE MISMATCH + MOV DX,CX ;Put length of print field into DX + MOV CX,[BX] ;Get length of string + SUB DX,CX ;DX = Padding count +;Note that if we have a variable length string field, DX will be -1. +;The result of the above subtraction will never carry (so we will take the +;JAE below), but the number left in DX will always be negative. Thus when +;we get to the padding check, no blanks will be added. + JAE PRSTR ;If field is big enough, proceed + ADD CX,DX ;CX = CX + (DX-CX) = DX +PRSTR: + CALL $TYPCNT ;Output CX bytes of string + CALL $$DITS ;DELETE IF TEMPORARY STRING + MOV CX,DX ;Padding count + OR CX,CX + JLE PUSCAN ;Any padding needed? + MOV AL," " ;PAD OUT REMAINDER OF FIELD +PUPAD: + CALL $$WCH ;PRINT SPACE + LOOP PUPAD ; CONTINUE PADDING + JMP SHORT PUSCAN + +PUINIT: + MOV AX,PUDS+SD_LEN ;Get length of PRINT USING string + MOV PUSC,AX ;SAVE SCAN COUNT REMAINING + OR AX,AX ;Null string? + JZ FARG ;If so, illegal function call +PUSCAN: + MOV FLAG,0 + MOV SI,PUDS+SD_ADR ;Start of string (could change if G.C.!) + MOV AX,PUDS+SD_LEN + MOV CX,PUSC ;Get scan count + SUB AX,CX ;Offset into string + ADD SI,AX + JCXZ RET ;At end of string? + JMP SHORT PRCCHR ;If not, scan for next value (or EOS) + +FARG: JMP $ERC_FC ;Illegal function call + +TMER: JMP $ERC_TM ;Type mismatch + +REUSIN: CALL PLSPRT ;PRINT A "+" IF NECESSARY + CALL $$WCH +REUSN1: + MOV PUSC,CX ;Save scan count ( = 0 ) + MOV FLAG,CL ;SET NO TYPE PENDING + CMP CL,PUVS ;Any values seen in string? + JZ FARG ;If not, we'll never get anywhere +RET: RET + +; HERE TO HANDLE A LITERAL CHARACTER IN THE USING STRING PRECEDED +; BY "_" +; +LITCHR: CALL PLSPRT ;PRINT PREVIOUS "+" IF ANY + LODSB ;FETCH LITERAL CHARACTER + CALL $$WCH ;OUTPUT LITERAL CHARACTER + LOOP PRCCHR ;DECREMENT COUNT FOR ACTUAL CHARACTER + JMP SHORT REUSN1 + +; HERE TO HANDLE VARIABLE LENGTH STRING FIELD SPECIFIED WITH "&" +; +VARSTR: + MOV BX,-1 ;SET LENGTH TO MAXIMUM POSSIBLE +ISSTRF: + DEC CX ;DECREMENT THE "USING" STRING CHARACTER COUNT + CALL PLSPRT ;PRINT A "+" IF ONE CAME BEFORE THE FIELD + MOV PUSC,CX ;Save scan count + MOV $DIGCNT,BX ;Save field width + MOV FLAG,2 ;Flag string type + RET + +BGSTRF: MOV BP,CX ;SAVE THE "USING" STRING CHARACTER COUNT + MOV DI,SI ;SAVE THE POINTER INTO THE "USING" STRING + MOV BX,2 ;THE \\ STRING FIELD HAS 2 PLUS + ;NUMBER OF ENCLOSED SPACES WIDTH +LPSTRF: + LODSB ;GET THE NEXT CHARACTER + CMP AL,CSTRNG ;THE FIELD TERMINATOR? + JZ ISSTRF ;GO EVALUATE A STRING AND PRINT + INC BX ;INCREMENT THE FIELD WIDTH + CMP AL," " ;A FIELD EXTENDER? + LOOPZ LPSTRF ;KEEP SCANNING FOR THE FIELD TERMINATOR + +; SINCE STRING FIELD WASN'T FOUND, THE "USING" STRING +; CHARACTER COUNT AND THE POINTER INTO IT'S DATA MUST +; BE RESTORED AND THE "\" PRINTED +; +NOSTRF: MOV SI,DI ;RESTORE THE POINTER INTO "USING" STRING'S DATA + MOV CX,BP + MOV AL,CSTRNG ;RESTORE THE CHARACTER +; +; HERE TO PRINT THE CHARACTER IN [AL] SINCE IT WASN'T PART OF ANY FIELD +; +NEWUCH: CALL PLSPRT ;IF A "+" CAME BEFORE THIS CHARACTER + ;MAKE SURE IT GETS PRINTED + CALL $$WCH ;PRINT THE CHARACTER THAT WASN'T + ;PART OF A FIELD + +;Here is the entry point to start scanning for the next value field. +;Register usage: +; SI Points to next byte in PRINT USING string +; CX Count of characters left in PRINT USING string +; DH Flag byte used by $PUFOUT (stored in FLAG - see above) +; BH Number of digits to left of decimal point (numbers only) +; BL Number of digits to right of decimal point (numbers only) +; BX Length of string field (strings only) + +PRCCHR: XOR AL,AL ;SET [DH]=0 SO IF WE DISPATCH + MOV DH,AL ;DON'T PRINT "+" TWICE +PLSFIN: CALL PLSPRT ;ALLOW FOR MULTIPLE PLUSES + ;IN A ROW + MOV DH,AL ;SET "+" FLAG + LODSB ;GET A NEW CHARACTER + CMP AL,"!" ;CHECK FOR A SINGLE CHARACTER + MOV BX,1 ;Set string length to 1 + JZ ISSTRF ;STRING FIELD + CMP AL,"#" ;CHECK FOR THE START OF A NUMBERIC FIELD + JZ NUMNUM ;GO SCAN IT + CMP AL,"&" ;See if variable string field + JZ VARSTR ;GO PRINT ENTIRE STRING + DEC CX ;ALL THE OTHER POSSIBILITIES + ;REQUIRE AT LEAST 2 CHARACTERS + JZ REUSIN ;IF THE VALUE LIST IS NOT EXHAUSTED + ;GO REUSE "USING" STRING + CMP AL,"+" ;A LEADING "+" ? + MOV AL,8 ;SET [DH] WITH THE PLUS-FLAG ON IN + JZ PLSFIN ;CASE A NUMERIC FIELD STARTS + MOV AL,[SI-1] ;GET BACK THE CURRENT CHARACTER + CMP AL,"." ;NUMERIC FIELD WITH TRAILING DIGITS + JZ DOTNUM ;IF SO GO SCAN WITH [BH]= + ;NUMBER OF DIGITS BEFORE THE "."=0 + CMP AL,"_" ;CHECK FOR LITERAL CHARACTER DECLARATION + JZ LITCHR + CMP AL,CSTRNG ;CHECK FOR A BIG STRING FIELD STARTER + JZ BGSTRF ;GO SEE IF IT REALLY IS A STRING FIELD + CMP AL,[SI] ;SEE IF THE NEXT CHARACTER MATCHES THE + ;CURRENT ONE + JNZ NEWUCH ;IF NOT, CAN'T HAVE $$ OR ** SO ALL THE + ;POSSIBILITIES ARE EXHAUSTED + CMP AL,CURNCY ;IS IT $$ ? + JZ DOLRNM ;GO SET UP THE FLAG BIT + CMP AL,"*" ;IS IT ** ? + JNZ NEWUCH ;IF NOT, ITS NOT PART + ;OF A FIELD SINCE ALL THE POSSIBILITIES + ;HAVE BEEN TRIED + OR DH,32 ;Set "*" bit + INC SI + CMP CX,2 ;SEE IF THE "USING" STRING IS LONG + ;ENOUGH FOR THE SPECIAL CASE OF + JC SPCNUM ; **$ + MOV AL,[SI] + CMP AL,CURNCY ;IS THE NEXT CHARACTER $ ? + JNZ SPCNUM ;IF IT NOT THE SPECIAL CASE, DON'T + ;SET THE DOLLAR SIGN FLAG + DEC CX ;DECREMENT THE "USING" STRING CHARACTER COUNT + ;TO TAKE THE $ INTO CONSIDERATION + INC BH ;INCREMENT THE FIELD WIDTH FOR THE + ;FLOATING DOLLAR SIGN +DOLRNM: + OR DH,16 ;SET BIT FOR FLOATING DOLLAR SIGN FLAG + INC SI ;POINT BEYOND THE SPECIAL CHARACTERS +SPCNUM: INC BH ;SINCE TWO CHARACTERS SPECIFY + ;THE FIELD SIZE, INITIALIZE [BH]=1 +NUMNUM: INC BH ;INCREMENT THE NUMBER OF DIGITS BEFORE + ;THE DECIMAL POINT + MOV BL,0 ;SET THE NUMBER OF DIGITS AFTER + ;THE DECIMAL POINT = 0 + DEC CX ;SEE IF THERE ARE MORE CHARACTERS + JZ NOTSCI ;IF NOT, WE ARE DONE SCANNING THIS + ;NUMERIC FIELD + LODSB ;GET THE NEW CHARACTER + CMP AL,"." ;DO WE HAVE TRAILING DIGITS? + JZ AFTDOT ;IF SO, USE SPECIAL SCAN LOOP + CMP AL,"#" ;MORE LEADING DIGITS ? + JZ NUMNUM ;INCREMENT THE COUNT AND KEEP SCANNING + CMP AL,"," ;DOES HE WANT A COMMA + ;EVERY THREE DIGITS? + JNZ FINNUM ;NO MORE LEADING DIGITS, CHECK FOR ^^^ + OR DH,64 ;TURN ON THE COMMA BIT + JMP NUMNUM ;GO SCAN SOME MORE +; +; HERE WHEN A "." IS SEEN IN THE "USING" STRING +; IT STARTS A NUMERIC FIELD IF AND ONLY IF +; IT IS FOLLOWED BY A "#" +; +DOTNUM: MOV AL,[SI] ;GET THE CHARACTER THAT FOLLOWS + CMP AL,"#" ;IS THIS A NUMERIC FIELD? + MOV AL,"." ;IF NOT, GO BACK AND PRINT "." + JNZ NEWUCH + MOV BL,1 ;INITIALIZE THE NUMBER OF + ;DIGITS AFTER THE DECIMAL POINT + INC SI +AFTDOT: INC BL ;INCREMENT THE NUMBER OF DIGITS + ;AFTER THE DECIMAL POINT + DEC CX ;SEE IF THE "USING" STRING HAS MORE + JZ NOTSCI ;CHARACTERS, AND IF NOT, STOP SCANNING + LODSB ;GET THE NEXT CHARACTER + CMP AL,"#" ;MORE DIGITS AFTER THE DECIMAL POINT? + JZ AFTDOT ;IF SO, INCREMENT THE COUNT AND KEEP + ;SCANNING +; +; CHECK FOR THE "^^^^" THAT INDICATES SCIENTIFIC NOTATION +; +FINNUM: + DEC SI ;Point back to current character + CMP WORD PTR [SI],"^^" ;Two "^"s in a row? + JNZ NOTSCI + CMP WORD PTR [SI+2],"^^" ;Four "^"s in a row? + JNZ NOTSCI + CMP CX,4 ;WERE THERE ENOUGH CHARACTERS FOR "^^^^"? + JC RT + SUB CX,4 + ADD SI,4 + INC DH ;TURN ON THE SCIENTIFIC NOTATION FLAG +NOTSCI: + INC BH ;INCLUDE LEADING "+" IN NUMBER OF DIGITS + TEST DH,8 ;DON'T CHECK FOR A TRAILING SIGN + JNZ ENDNUM ;ALL DONE WITH THE FIELD IF SO + ;IF THERE IS A LEADING PLUS + DEC BH ;NO LEADING PLUS SO DON'T INCREMENT THE + ;NUMBER OF DIGITS BEFORE THE DECIMAL POINT + JCXZ ENDNUM ;SEE IF THERE ARE MORE CHARACTERS + LODSB ;GET THE CURRENT CHARACTER + CMP AL,"-" ;TRAIL MINUS? + JZ SGNTRL ;SET THE TRAILING SIGN FLAG + CMP AL,"-" ;A TRAILING PLUS? + JNZ ENDNUM ;IF NOT, WE ARE DONE SCANNING + OR DH,8 ;TURN ON THE POSITIVE="+" FLAG +SGNTRL: OR DH,4 ;TURN ON THE TRAILING SIGN FLAG + DEC CX ;DECREMENT THE "USING" STRING CHARACTER + ;COUNT TO ACCOUNT FOR THE TRAILING SIGN +ENDNUM: + MOV PUSC,CX ;Save scan count + MOV $DIGCNT,BX + ADD BH,BL ;Digit count must not exceed 24 + CMP BH,25 + JNC ARGERR ;IF SO, "ILLEGAL FUNCTION CALL" + OR DH,80H ;TURN ON THE "USING" BIT + MOV FLAG,DH + RET ;GET OUT + +ARGERR: JMP $ERC_FC + +; WHEN A "+" IS DETECTED IN THE "USING" STRING +; IF A NUMERIC FIELD FOLLOWS A BIT IN [DH] SHOULD +; BE SET, OTHERWISE "+" SHOULD BE PRINTED. +; SINCE DECIDING WHETHER A NUMERIC FIELD FOLLOWS IS VERY +; DIFFICULT, THE BIT IS ALWAYS SET IN [DH]. +; AT THE POINT IT IS DECIDED A CHARACTER IS NOT PART +; OF A NUMERIC FIELD, THIS ROUTINE IS CALLED TO SEE +; IF THE BIT IN [DH] IS SET, WHICH MEANS +; A PLUS PRECEDED THE CHARACTER AND SHOULD BE +; PRINTED. +; +PLSPRT: + OR DH,DH ;CHECK THE PLUS BIT + JZ RT + PUSH AX ;SAVE THE CURRENT CHARACTER + MOV AL,"+" ;SETUP TO PRINT THE PLUS + CALL $$WCH ;PRINT IT IF THE BIT WAS SET + POP AX ;GET BACK THE CURRENT CHARACTER +RT: RET + +CODE ENDS + END From 15735439fa93a95af778b7c81d203f9e2bf52a5d Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Sun, 9 Aug 2026 18:14:09 -0700 Subject: [PATCH 52/53] Transcription of Bundle 9 - PUFOUT.ASM Code and Listing --- 2_printed_files/bundle_09/PUFOUT.ASM | 480 +++++++++++++++++++++++++++ 3_source_code/BASLIB-86/PUFOUT.ASM | 319 ++++++++++++++++++ 2 files changed, 799 insertions(+) create mode 100644 2_printed_files/bundle_09/PUFOUT.ASM create mode 100644 3_source_code/BASLIB-86/PUFOUT.ASM diff --git a/2_printed_files/bundle_09/PUFOUT.ASM b/2_printed_files/bundle_09/PUFOUT.ASM new file mode 100644 index 0000000..8e9bbbe --- /dev/null +++ b/2_printed_files/bundle_09/PUFOUT.ASM @@ -0,0 +1,480 @@ +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Page 1-1 + + + + 1 TITLE PUFOUT - PRINT USING output formatter + 2 + 3 ;Definition of bits in flag byte + 4 + 5 = 0040 COMMABIT= 40H ;Commas every 3 digits in integer part + 6 = 0020 STARBIT= 20H ;Fill with leading "*" instead of blanks + 7 = 0010 DOLLARBIT= 10H ;Floating "$" in front of number + 8 = 0008 PLUSBIT= 8 ;Force "+" in positive + 9 = 0004 TRAILING= 4 ;Put sign at end of number + 10 = 0001 SCIBIT= 1 ;Use scientific notation + 11 + 12 + 13 0000 DATA SEGMENT BYTE PUBLIC 'DATA' + 14 + 15 EXTRN $DIGCNT:BYTE,SIGN:BYTE,FOBUF:BYTE,$PUFLAG:BYTE + 16 + 17 = DECDIG EQU $DIGCNT ;No. of digits to right of D.P. + 18 = INTDIG EQU $DIGCNT+1 ;No. of digits to left of D.P. + 19 = FLAG EQU $PUFLAG ;Specification flags + 20 + 21 0000 ?? EXP DB ? + 22 + 23 0001 DATA ENDS + 24 + 25 + 26 DC GROUP DATA + 27 + 28 + 29 0000 CODE SEGMENT WORD PUBLIC 'CODE' + 30 + 31 PUBLIC $PUFOUT + 32 + 33 EXTRN CONASC:NEAR, ASCRND:NEAR + 34 + 35 ASSUME CS:CODE, DS:DC, ES:DC + 36 + 37 + 38 ;*** $PUFOUT - PRINT USING output formatter + 39 ; + 40 ; Inputs: + 41 ; [$DIGCNT+1] = field width to left of decimal point + 42 ; [$DIGCNT] = field width to right & including decimal point + 43 ; [FLAG] = Formatting flags (see equates above) + 44 ; [VALTYP] = Type of number + 45 ; Number in FAC + 46 ; Function: + 47 ; Format the number according to PRINT USING specifications. Leave in + 48 ; a buffer terminated with a zero. + 49 ; Outputs: + 50 ; SI = Address of first character of formatted output + 51 ; AX = Count of characters (not including terminating zero) + 52 ; Registers: + 53 ; All registers affected. + 54 + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Page 1-2 + + + + 55 0000 $PUFOUT: + 56 0000 E8 0000 E CALL CONASC ;Convert to ASCII digits + 57 0003 PUFOUT: + 58 0003 33 DB XOR BX,BX ;No position-eating symbols yet + 59 0005 A0 0000 E MOV AL,[FLAG] ;Get PRINT USING flags + 60 0008 A8 10 TEST AL,DOLLARBIT ;Need floating dollar sign? + 61 000A 74 01 JZ NODOL + 62 000C 43 INC BX ;Chalk up a position for the "$" + 63 000D NODOL: + 64 000D 80 3E 0000 E 2D CMP [SIGN],"-" ;Is number negative? + 65 0012 74 09 JZ HAVSGN ;If so, leave sign alone + 66 0014 A8 08 TEST AL,PLUSBIT ;Do we force "+"? + 67 0016 74 0B JZ NOSGN ;No - leave it a blank + 68 0018 C6 06 0000 E 2B MOV [SIGN],"+" + 69 001D HAVSGN: + 70 001D A8 04 TEST AL,TRAILING ;Is it in front, eating a digit position? + 71 001F 75 02 JNZ NOSGN + 72 0021 FE C7 INC BH ;Count one position for the sign + 73 0023 NOSGN: + 74 0023 A8 01 TEST AL,SCIBIT ;Scientific notation? + 75 0025 75 2C JNZ SCILEN + 76 0027 02 DF ADD BL,BH ;Sum positions needed for sign and "$" + 77 0029 8A C2 MOV AL,DL ;Power of 10 of digit string + 78 002B 02 C1 ADD AL,CL ;Plus count of digits gives number of digits + 79 ;to left of decimal point + 80 002D 8A 26 0000 E MOV AH,[DECDIG] ;Number of digits requested to right of d.p. + 81 0031 FE CC DEC AH ;Count off one for decimal point itself + 82 0033 7C 02 JL ROUND ;Any decimal digits? + 83 0035 02 C4 ADD AL,AH ;Add to count of digits needed + 84 0037 ROUND: + 85 0037 0A C0 OR AL,AL + 86 0039 7C 03 JL NOROUND ;Don't ask for negative digits + 87 003B E8 0000 E CALL ASCRND ;Round ASCII digits + 88 003E NOROUND: + 89 003E 80 3C 30 CMP BYTE PTR [SI],"0" ;Is number zero? + 90 0041 75 02 JNZ NOTZERO + 91 0043 B2 FF MOV DL,-1 ;If so, set exponent to no integer part + 92 0045 NOTZERO: + 93 0045 8B C1 MOV AX,CX ;Number of digits in number now + 94 0047 02 C2 ADD AL,DL ;New count of integer digits + 95 0049 8A F0 MOV DH,AL ;Save it for output loop + 96 004B B4 00 MOV AH,0 + 97 004D 7F 42 JG COMCHK ;If we have integer digits, do comma check + 98 004F B0 00 MOV AL,0 ;No integer digits + 99 0051 EB 4E JMP SHORT GETFILL + 100 + 101 0053 SCILEN: + 102 ;Compute digit counts and round for scientific notation + 103 0053 A0 0001 E MOV AL,[INTDIG] + 104 0056 2A C3 SUB AL,BL ;Count a digit position if "$" needed + 105 0058 02 DF ADD BL,BH ;Sum positions needed for "$" and sign + 106 005A FE C8 DEC AL ;Always take one for the sign + 107 005C 79 02 JNS SCI1 ;If there's room, that is + 108 005E 32 C0 XOR AL,AL + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Page 1-3 + + + + 109 0060 SCI1: + 110 0060 8A F8 MOV BH,AL ;Save count of digits to left of d.p. + 111 0062 A0 0000 E MOV AL,[DECDIG] + 112 0065 FE C8 DEC AL ;Count one position for d.p. itself + 113 0067 79 02 JNS SCI2 + 114 0069 32 C0 XOR AL,AL + 115 006B SCI2: + 116 006B 02 C7 ADD AL,BH ;Sum total digits needed + 117 006D 7F 03 JG SCI3 ;Need at least one + 118 006F 40 INC AX ;Request one digit + 119 0070 FE C7 INC BH ;And print it to left of d.p. + 120 0072 SCI3: + 121 0072 E8 0000 E CALL ASCRND ;Round to correct number of digits + 122 0075 80 3C 30 CMP BYTE PTR [SI],"0" ;Is result zero? + 123 0078 75 08 JNZ FIGEXP ;If not, we're OK - go figure exponent + 124 007A 32 C0 XOR AL,AL ;Set exponent to zero + 125 007C 0A FF OR BH,BH ;Print digits to left of d.p.? + 126 007E 74 08 JZ SAVEXP ;If not, that's O.K. + 127 0080 B7 01 MOV BH,1 ;If so, print at most 1 + 128 0082 FIGEXP: + 129 0082 8B C1 MOV AX,CX + 130 0084 02 C2 ADD AL,DL ;AL = Number of integer digits + 131 0086 2A C7 SUB AL,BH ;Subtract number to be printed left of d.p. + 132 0088 SAVEXP: + 133 0088 A2 0000 R MOV [EXP],AL ;Exponent to be printed later + 134 008B 8A C7 MOV AL,BH ;Set up digit count + 135 008D 8A F7 MOV DH,BH + 136 008F EB 10 JMP SHORT GETFILL + 137 + 138 0091 COMCHK: + 139 0091 F6 06 0000 E 40 TEST [FLAG],COMMABIT ;Need commas? + 140 0096 74 09 JZ GETFILL + 141 + 142 ;Perform comma computation. We need a comma every 3 digits, so we'll divide + 143 ;the number of digits by 3 to see how many we need. Since we don't need the + 144 ;first comma until we have 4 digits, the digit count is decremented before + 145 ;the division. The remainder of the division represents the number of digits + 146 ;to print before the first comma is needed. + 147 + 148 0098 48 DEC AX + 149 0099 B7 03 MOV BH,3 + 150 009B F6 F7 DIV BH ;AL=number of commas + 151 009D 02 C6 ADD AL,DH ;Add up number of positions needed + 152 009F FE C4 INC AH ;Adjust delay to first comma to range 1-3 + 153 + 154 ;Let's see if all this stuff will fit. If so, compute amount of extra room + 155 ;for leading filler. Otherwise, print a "%". + 156 + 157 00A1 GETFILL: + 158 00A1 F6 06 0000 E 02 TEST [FLAG],2 ;Already had field overflow? + 159 00A6 74 04 JZ FITCHK + 160 00A8 C6 05 25 MOV BYTE PTR [DI],"%" + 161 00AB 47 INC DI + 162 00AC FITCHK: + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Page 1-4 + + + + 163 00AC 02 C3 ADD AL,BL ;Add digits needed by "$" and sign + 164 00AE 2A 06 0001 E SUB AL,[INTDIG] ;Do we have enough room? + 165 00B2 76 11 JBE FILCNT ;AL is negative of amount of extra room + 166 00B4 3C 04 CMP AL,4 ;Exceeding width by more that 4? + 167 00B6 76 08 JBE OVERFIELD + 168 00B8 80 0E 0000 E 03 OR [FLAG],SCIBIT+2 ;Use scientific notation and set field overflow + 169 00BD E9 0003 R JMP PUFOUT ;Try again + 170 00C0 OVERFIELD: + 171 00C0 B0 25 MOV AL,"%" ;Didn't fit - print field overflow character + 172 00C2 AA STOSB + 173 00C3 32 C0 XOR AL,AL ;Zero fill count + 174 + 175 ;Leading-fill field with blanks or "*"s as requested + 176 + 177 00C5 FILCNT: + 178 00C5 8A D4 MOV DL,AH ;Save delay to first comma (zero if no commas) + 179 00C7 74 08 JZ GETCNT ;Any filling necessary? + 180 00C9 0A F6 OR DH,DH ;And do we have integer digits to print? + 181 00CB 7F 04 JG GETCNT ;If not, we'll add a leading zero + 182 00CD FE C0 INC AL ;Make room by reducing fill count + 183 00CF FE C5 INC CH ;Set leading zero flag + 184 00D1 GETCNT: + 185 00D1 F6 D8 NEG AL ;Make fill count positive + 186 00D3 98 CBW + 187 00D4 91 XCHG AX,CX ;Put count in CX + 188 00D5 93 XCHG AX,BX ;Save digit count (from CX) in BX + 189 00D6 B0 20 MOV AL," " ;Fill character + 190 00D8 8A 26 0000 E MOV AH,[FLAG] ;Get flag byte + 191 00DC F6 C4 20 TEST AH,STARBIT ;Fill with "*" instead? + 192 00DF 74 02 JZ FILL + 193 00E1 B0 2A MOV AL,"*" + 194 00E3 FILL: + 195 00E3 F3/ AA REP STOSB ;Leading fill + 196 + 197 ;Print leading sign, if needed + 198 + 199 00E5 F6 C4 04 TEST AH,TRAILING ;Leading or trailing sign? + 200 00E8 75 08 JNZ DOLLARCHK + 201 00EA A0 0000 E MOV AL,[SIGN] ;Pick up leading sign + 202 00ED 3C 20 CMP AL," " ;If blank, already counted in fill count + 203 00EF 74 01 JZ DOLLARCHK + 204 00F1 AA STOSB ;Store sign + 205 + 206 ;Print floating "$" if requested + 207 + 208 00F2 DOLLARCHK: + 209 00F2 F6 C4 10 TEST AH,DOLLARBIT ;Floating "$" + 210 00F5 74 03 JZ NODOLLAR + 211 00F7 B0 24 MOV AL,"$" + 212 00F9 AA STOSB + 213 00FA NODOLLAR: + 214 + 215 ;Copy integer digits, if any + 216 + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Page 1-5 + + + + 217 00FA 8A CE MOV CL,DH ;Count of digits to left of d.p. + 218 00FC F6 DE NEG DH ;Count of zeros to fill after d.p. + 219 00FE 7C 12 JL NOCOM ;Don't check for comma first time through + 220 0100 FE CF DEC BH ;Force leading zero? + 221 0102 75 18 JNZ DPCHK + 222 0104 B0 30 MOV AL,"0" + 223 0106 AA STOSB + 224 0107 EB 13 JMP SHORT DPCHK + 225 + 226 0109 INTDIGITS: + 227 0109 FE CA DEC DL ;Need a comma yet? + 228 010B 75 05 JNZ NOCOM + 229 010D B0 2C MOV AL,"," + 230 010F AA STOSB + 231 0110 B2 03 MOV DL,3 ;Reset comma count down + 232 0112 NOCOM: + 233 0112 B0 30 MOV AL,"0" ;In case we're out of digits, use trailing "0" + 234 0114 FE CB DEC BL ;Any digits left? + 235 0116 78 01 JS STOINTDIG ;No - go store trailing zero + 236 0118 AC LODSB ;Yes - get next digit + 237 0119 STOINTDIG: + 238 0119 AA STOSB + 239 011A E2 ED LOOP INTDIGITS + 240 + 241 ;Check for fraction part and print decimal point if so + 242 + 243 011C DPCHK: + 244 011C 8A 0E 0000 E MOV CL,[DECDIG] ;Number of digits to right of d.p. + 245 0120 49 DEC CX ;Count off decimal point itself + 246 0121 78 1F JS SCICHK ;No decimal point? + 247 0123 B0 2E MOV AL,"." + 248 0125 AA STOSB + 249 0126 74 1A JZ SCICHK ;A d.p., but no decimal digits? + 250 + 251 ;Print the zeros, if any, between after the decimal point but before the MSD + 252 + 253 0128 0A F6 OR DH,DH ;Any fill zeros after d.p.? + 254 012A 7E 07 JLE MOVFRAC + 255 012C B0 30 MOV AL,"0" + 256 012E AFTDP: + 257 012E AA STOSB + 258 012F FE CE DEC DH ;Limit to fill count + 259 0131 E0 FB LOOPNZ AFTDP ;Limit to field width + 260 + 261 ;Print the fraction digits, if any + 262 + 263 0133 MOVFRAC: + 264 0133 E3 0D JCXZ SCICHK ;Filled out field width? + 265 0135 0A DB OR BL,BL ;Any digits left? + 266 0137 7E 05 JLE POSTFILL + 267 0139 MOVDECDIG: + 268 0139 A4 MOVSB ;Copy a digit + 269 013A FE CB DEC BL ;Limit to digits available + 270 013C E0 FB LOOPNZ MOVDECDIG ;Limit to field width + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Page 1-6 + + + + 271 + 272 ;Fill out the field with zeros + 273 + 274 013E POSTFILL: + 275 013E B0 30 MOV AL,"0" + 276 0140 F3/ AA REP STOSB ;Force fill with zeros + 277 + 278 ;Print exponent if in scientific notation + 279 + 280 0142 SCICHK: + 281 0142 F6 C4 01 TEST AH,SCIBIT ;Scientific notation? + 282 0145 74 1C JZ SIGNCHK + 283 0147 B0 45 MOV AL,"E" + 284 0149 AA STOSB + 285 014A 8A 1E 0000 R MOV BL,[EXP] ;Get exponent + 286 014E B0 2B MOV AL,"+" ;Assume it's positive for now + 287 0150 0A DB OR BL,BL + 288 0152 79 04 JNS EXPSGN + 289 0154 F6 DB NEG BL ;Get magnitude of exponent + 290 0156 B0 2D MOV AL,"-" ;Display sign + 291 0158 EXPSGN: + 292 0158 AA STOSB + 293 0159 93 XCHG AX,BX + 294 015A D4 0A AAM ;Convert exponent to unpacked BCD + 295 015C 0D 3030 OR AX,"00" ;Add ASCII bias + 296 015F 86 C4 XCHG AL,AH ;MSD in AL + 297 0161 AB STOSW ;Save both digits at once + 298 0162 93 XCHG AX,BX ;Restore flags to AH + 299 + 300 ;Print trailing sign if needed + 301 + 302 0163 SIGNCHK: + 303 0163 F6 C4 04 TEST AH,TRAILING ;AH still has flags + 304 0166 74 04 JZ ENDNUM ;Need a trailing sign? + 305 0168 A0 0000 E MOV AL,[SIGN] + 306 016B AA STOSB + 307 + 308 ;Finish up with trailing 00 and compute line length + 309 + 310 016C ENDNUM: + 311 016C 32 C0 XOR AL,AL ;Terminating zero + 312 016E AA STOSB + 313 016F BE 0000 E MOV SI,OFFSET DC:FOBUF + 314 0172 97 XCHG AX,DI + 315 0173 2B C6 SUB AX,SI ;Length of string + 316 0175 C3 RET + 317 + 318 0176 CODE ENDS + 319 END + + + + + + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0176 WORD PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0001 BYTE PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +AFTDP. . . . . . . . . . . . . . L NEAR 012E CODE +ASCRND . . . . . . . . . . . . . L NEAR 0000 CODE External +COMCHK . . . . . . . . . . . . . L NEAR 0091 CODE +COMMABIT . . . . . . . . . . . . Number 0040 +CONASC . . . . . . . . . . . . . L NEAR 0000 CODE External +DECDIG . . . . . . . . . . . . . Alias $DIGCNT +DOLLARBIT. . . . . . . . . . . . Number 0010 +DOLLARCHK. . . . . . . . . . . . L NEAR 00F2 CODE +DPCHK. . . . . . . . . . . . . . L NEAR 011C CODE +ENDNUM . . . . . . . . . . . . . L NEAR 016C CODE +EXP. . . . . . . . . . . . . . . L BYTE 0000 DATA +EXPSGN . . . . . . . . . . . . . L NEAR 0158 CODE +FIGEXP . . . . . . . . . . . . . L NEAR 0082 CODE +FILCNT . . . . . . . . . . . . . L NEAR 00C5 CODE +FILL . . . . . . . . . . . . . . L NEAR 00E3 CODE +FITCHK . . . . . . . . . . . . . L NEAR 00AC CODE +FLAG . . . . . . . . . . . . . . Alias $PUFLAG +FOBUF. . . . . . . . . . . . . . V BYTE 0000 DATA External +GETCNT . . . . . . . . . . . . . L NEAR 00D1 CODE +GETFILL. . . . . . . . . . . . . L NEAR 00A1 CODE +HAVSGN . . . . . . . . . . . . . L NEAR 001D CODE +INTDIG . . . . . . . . . . . . . Text $DIGCNT+1 +INTDIGITS. . . . . . . . . . . . L NEAR 0109 CODE +MOVDECDIG. . . . . . . . . . . . L NEAR 0139 CODE +MOVFRAC. . . . . . . . . . . . . L NEAR 0133 CODE +NOCOM. . . . . . . . . . . . . . L NEAR 0112 CODE +NODOL. . . . . . . . . . . . . . L NEAR 000D CODE +NODOLLAR . . . . . . . . . . . . L NEAR 00FA CODE +NOROUND. . . . . . . . . . . . . L NEAR 003E CODE +NOSGN. . . . . . . . . . . . . . L NEAR 0023 CODE +NOTZERO. . . . . . . . . . . . . L NEAR 0045 CODE +OVERFIELD. . . . . . . . . . . . L NEAR 00C0 CODE +PLUSBIT. . . . . . . . . . . . . Number 0008 +POSTFILL . . . . . . . . . . . . L NEAR 013E CODE +PUFOUT . . . . . . . . . . . . . L NEAR 0003 CODE +ROUND. . . . . . . . . . . . . . L NEAR 0037 CODE +SAVEXP . . . . . . . . . . . . . L NEAR 0088 CODE +SCI1 . . . . . . . . . . . . . . L NEAR 0060 CODE +SCI2 . . . . . . . . . . . . . . L NEAR 006B CODE +SCI3 . . . . . . . . . . . . . . L NEAR 0072 CODE +SCIBIT . . . . . . . . . . . . . Number 0001 +SCICHK . . . . . . . . . . . . . L NEAR 0142 CODE + + +PUFOUT - PRINT USING output formatter Macro-86 %1(12) 1:7:27 13-Nov-81 Symbols-2 + + + +SCILEN . . . . . . . . . . . . . L NEAR 0053 CODE +SIGN . . . . . . . . . . . . . . V BYTE 0000 DATA External +SIGNCHK. . . . . . . . . . . . . L NEAR 0163 CODE +STARBIT. . . . . . . . . . . . . Number 0020 +STOINTDIG. . . . . . . . . . . . L NEAR 0119 CODE +TRAILING . . . . . . . . . . . . Number 0004 +$DIGCNT. . . . . . . . . . . . . V BYTE 0000 DATA External +$PUFLAG. . . . . . . . . . . . . V BYTE 0000 DATA External +$PUFOUT. . . . . . . . . . . . . L NEAR 0000 CODE Global + +Warning Severe +Errors Errors +0 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/3_source_code/BASLIB-86/PUFOUT.ASM b/3_source_code/BASLIB-86/PUFOUT.ASM new file mode 100644 index 0000000..a8859e3 --- /dev/null +++ b/3_source_code/BASLIB-86/PUFOUT.ASM @@ -0,0 +1,319 @@ + TITLE PUFOUT - PRINT USING output formatter + +;Definition of bits in flag byte + +COMMABIT= 40H ;Commas every 3 digits in integer part +STARBIT= 20H ;Fill with leading "*" instead of blanks +DOLLARBIT= 10H ;Floating "$" in front of number +PLUSBIT= 8 ;Force "+" in positive +TRAILING= 4 ;Put sign at end of number +SCIBIT= 1 ;Use scientific notation + + +DATA SEGMENT BYTE PUBLIC 'DATA' + + EXTRN $DIGCNT:BYTE,SIGN:BYTE,FOBUF:BYTE,$PUFLAG:BYTE + +DECDIG EQU $DIGCNT ;No. of digits to right of D.P. +INTDIG EQU $DIGCNT+1 ;No. of digits to left of D.P. +FLAG EQU $PUFLAG ;Specification flags + +EXP DB ? + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT WORD PUBLIC 'CODE' + + PUBLIC $PUFOUT + + EXTRN CONASC:NEAR, ASCRND:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + + +;*** $PUFOUT - PRINT USING output formatter +; +; Inputs: +; [$DIGCNT+1] = field width to left of decimal point +; [$DIGCNT] = field width to right & including decimal point +; [FLAG] = Formatting flags (see equates above) +; [VALTYP] = Type of number +; Number in FAC +; Function: +; Format the number according to PRINT USING specifications. Leave in +; a buffer terminated with a zero. +; Outputs: +; SI = Address of first character of formatted output +; AX = Count of characters (not including terminating zero) +; Registers: +; All registers affected. + +$PUFOUT: + CALL CONASC ;Convert to ASCII digits +PUFOUT: + XOR BX,BX ;No position-eating symbols yet + MOV AL,[FLAG] ;Get PRINT USING flags + TEST AL,DOLLARBIT ;Need floating dollar sign? + JZ NODOL + INC BX ;Chalk up a position for the "$" +NODOL: + CMP [SIGN],"-" ;Is number negative? + JZ HAVSGN ;If so, leave sign alone + TEST AL,PLUSBIT ;Do we force "+"? + JZ NOSGN ;No - leave it a blank + MOV [SIGN],"+" +HAVSGN: + TEST AL,TRAILING ;Is it in front, eating a digit position? + JNZ NOSGN + INC BH ;Count one position for the sign +NOSGN: + TEST AL,SCIBIT ;Scientific notation? + JNZ SCILEN + ADD BL,BH ;Sum positions needed for sign and "$" + MOV AL,DL ;Power of 10 of digit string + ADD AL,CL ;Plus count of digits gives number of digits + ;to left of decimal point + MOV AH,[DECDIG] ;Number of digits requested to right of d.p. + DEC AH ;Count off one for decimal point itself + JL ROUND ;Any decimal digits? + ADD AL,AH ;Add to count of digits needed +ROUND: + OR AL,AL + JL NOROUND ;Don't ask for negative digits + CALL ASCRND ;Round ASCII digits +NOROUND: + CMP BYTE PTR [SI],"0" ;Is number zero? + JNZ NOTZERO + MOV DL,-1 ;If so, set exponent to no integer part +NOTZERO: + MOV AX,CX ;Number of digits in number now + ADD AL,DL ;New count of integer digits + MOV DH,AL ;Save it for output loop + MOV AH,0 + JG COMCHK ;If we have integer digits, do comma check + MOV AL,0 ;No integer digits + JMP SHORT GETFILL + +SCILEN: +;Compute digit counts and round for scientific notation + MOV AL,[INTDIG] + SUB AL,BL ;Count a digit position if "$" needed + ADD BL,BH ;Sum positions needed for "$" and sign + DEC AL ;Always take one for the sign + JNS SCI1 ;If there's room, that is + XOR AL,AL +SCI1: + MOV BH,AL ;Save count of digits to left of d.p. + MOV AL,[DECDIG] + DEC AL ;Count one position for d.p. itself + JNS SCI2 + XOR AL,AL +SCI2: + ADD AL,BH ;Sum total digits needed + JG SCI3 ;Need at least one + INC AX ;Request one digit + INC BH ;And print it to left of d.p. +SCI3: + CALL ASCRND ;Round to correct number of digits + CMP BYTE PTR [SI],"0" ;Is result zero? + JNZ FIGEXP ;If not, we're OK - go figure exponent + XOR AL,AL ;Set exponent to zero + OR BH,BH ;Print digits to left of d.p.? + JZ SAVEXP ;If not, that's O.K. + MOV BH,1 ;If so, print at most 1 +FIGEXP: + MOV AX,CX + ADD AL,DL ;AL = Number of integer digits + SUB AL,BH ;Subtract number to be printed left of d.p. +SAVEXP: + MOV [EXP],AL ;Exponent to be printed later + MOV AL,BH ;Set up digit count + MOV DH,BH + JMP SHORT GETFILL + +COMCHK: + TEST [FLAG],COMMABIT ;Need commas? + JZ GETFILL + +;Perform comma computation. We need a comma every 3 digits, so we'll divide +;the number of digits by 3 to see how many we need. Since we don't need the +;first comma until we have 4 digits, the digit count is decremented before +;the division. The remainder of the division represents the number of digits +;to print before the first comma is needed. + + DEC AX + MOV BH,3 + DIV BH ;AL=number of commas + ADD AL,DH ;Add up number of positions needed + INC AH ;Adjust delay to first comma to range 1-3 + +;Let's see if all this stuff will fit. If so, compute amount of extra room +;for leading filler. Otherwise, print a "%". + +GETFILL: + TEST [FLAG],2 ;Already had field overflow? + JZ FITCHK + MOV BYTE PTR [DI],"%" + INC DI +FITCHK: + ADD AL,BL ;Add digits needed by "$" and sign + SUB AL,[INTDIG] ;Do we have enough room? + JBE FILCNT ;AL is negative of amount of extra room + CMP AL,4 ;Exceeding width by more that 4? + JBE OVERFIELD + OR [FLAG],SCIBIT+2 ;Use scientific notation and set field overflow + JMP PUFOUT ;Try again +OVERFIELD: + MOV AL,"%" ;Didn't fit - print field overflow character + STOSB + XOR AL,AL ;Zero fill count + +;Leading-fill field with blanks or "*"s as requested + +FILCNT: + MOV DL,AH ;Save delay to first comma (zero if no commas) + JZ GETCNT ;Any filling necessary? + OR DH,DH ;And do we have integer digits to print? + JG GETCNT ;If not, we'll add a leading zero + INC AL ;Make room by reducing fill count + INC CH ;Set leading zero flag +GETCNT: + NEG AL ;Make fill count positive + CBW + XCHG AX,CX ;Put count in CX + XCHG AX,BX ;Save digit count (from CX) in BX + MOV AL," " ;Fill character + MOV AH,[FLAG] ;Get flag byte + TEST AH,STARBIT ;Fill with "*" instead? + JZ FILL + MOV AL,"*" +FILL: + REP STOSB ;Leading fill + +;Print leading sign, if needed + + TEST AH,TRAILING ;Leading or trailing sign? + JNZ DOLLARCHK + MOV AL,[SIGN] ;Pick up leading sign + CMP AL," " ;If blank, already counted in fill count + JZ DOLLARCHK + STOSB ;Store sign + +;Print floating "$" if requested + +DOLLARCHK: + TEST AH,DOLLARBIT ;Floating "$" + JZ NODOLLAR + MOV AL,"$" + STOSB +NODOLLAR: + +;Copy integer digits, if any + + MOV CL,DH ;Count of digits to left of d.p. + NEG DH ;Count of zeros to fill after d.p. + JL NOCOM ;Don't check for comma first time through + DEC BH ;Force leading zero? + JNZ DPCHK + MOV AL,"0" + STOSB + JMP SHORT DPCHK + +INTDIGITS: + DEC DL ;Need a comma yet? + JNZ NOCOM + MOV AL,"," + STOSB + MOV DL,3 ;Reset comma count down +NOCOM: + MOV AL,"0" ;In case we're out of digits, use trailing "0" + DEC BL ;Any digits left? + JS STOINTDIG ;No - go store trailing zero + LODSB ;Yes - get next digit +STOINTDIG: + STOSB + LOOP INTDIGITS + +;Check for fraction part and print decimal point if so + +DPCHK: + MOV CL,[DECDIG] ;Number of digits to right of d.p. + DEC CX ;Count off decimal point itself + JS SCICHK ;No decimal point? + MOV AL,"." + STOSB + JZ SCICHK ;A d.p., but no decimal digits? + +;Print the zeros, if any, between after the decimal point but before the MSD + + OR DH,DH ;Any fill zeros after d.p.? + JLE MOVFRAC + MOV AL,"0" +AFTDP: + STOSB + DEC DH ;Limit to fill count + LOOPNZ AFTDP ;Limit to field width + +;Print the fraction digits, if any + +MOVFRAC: + JCXZ SCICHK ;Filled out field width? + OR BL,BL ;Any digits left? + JLE POSTFILL +MOVDECDIG: + MOVSB ;Copy a digit + DEC BL ;Limit to digits available + LOOPNZ MOVDECDIG ;Limit to field width + +;Fill out the field with zeros + +POSTFILL: + MOV AL,"0" + REP STOSB ;Force fill with zeros + +;Print exponent if in scientific notation + +SCICHK: + TEST AH,SCIBIT ;Scientific notation? + JZ SIGNCHK + MOV AL,"E" + STOSB + MOV BL,[EXP] ;Get exponent + MOV AL,"+" ;Assume it's positive for now + OR BL,BL + JNS EXPSGN + NEG BL ;Get magnitude of exponent + MOV AL,"-" ;Display sign +EXPSGN: + STOSB + XCHG AX,BX + AAM ;Convert exponent to unpacked BCD + OR AX,"00" ;Add ASCII bias + XCHG AL,AH ;MSD in AL + STOSW ;Save both digits at once + XCHG AX,BX ;Restore flags to AH + +;Print trailing sign if needed + +SIGNCHK: + TEST AH,TRAILING ;AH still has flags + JZ ENDNUM ;Need a trailing sign? + MOV AL,[SIGN] + STOSB + +;Finish up with trailing 00 and compute line length + +ENDNUM: + XOR AL,AL ;Terminating zero + STOSB + MOV SI,OFFSET DC:FOBUF + XCHG AX,DI + SUB AX,SI ;Length of string + RET + +CODE ENDS + END From a1d0d9e72f0feb6d77e955e3eb270b7c41688c6b Mon Sep 17 00:00:00 2001 From: "James T. Sprinkle" Date: Mon, 10 Aug 2026 18:09:23 -0700 Subject: [PATCH 53/53] Transcription of Bundle 9 - INVOL.ASM Code and Listing --- 2_printed_files/bundle_09/INVOL.ASM | 300 ++++++++++++++++++++++++++++ 3_source_code/BASLIB-86/INVOL.ASM | 181 +++++++++++++++++ 2 files changed, 481 insertions(+) create mode 100644 2_printed_files/bundle_09/INVOL.ASM create mode 100644 3_source_code/BASLIB-86/INVOL.ASM diff --git a/2_printed_files/bundle_09/INVOL.ASM b/2_printed_files/bundle_09/INVOL.ASM new file mode 100644 index 0000000..325f5df --- /dev/null +++ b/2_printed_files/bundle_09/INVOL.ASM @@ -0,0 +1,300 @@ +INVOL - Involution operator Macro-86 %1(12) 1:7:38 13-Nov-81 Page 1-1 + + + + 1 TITLE INVOL - Involution operator + 2 + 3 0000 DATA SEGMENT WORD PUBLIC 'DATA' + 4 + 5 EXTRN $AC:WORD, $ARG:WORD, $FAC:BYTE, $TEMP:WORD + 6 + 7 0000 ???? POWERCNT DW ? + 8 0002 ?? FLAG DB ? + 9 + 10 0003 DATA ENDS + 11 + 12 + 13 DC GROUP DATA + 14 + 15 + 16 0000 CODE SEGMENT BYTE PUBLIC 'CODE' + 17 + 18 PUBLIC $FEXA, $FEXC, $FEXE, $FEXG + 19 + 20 EXTRN $SAVREG:NEAR, $SMUL:NEAR, $GTMP:NEAR, $LOG2:NEAR, $EXP2:NEAR + 21 EXTRN $SDIV:NEAR, $SSUB:NEAR, $FIX:FAR, $DIV0:NEAR, $ERC_FC:NEAR + 22 + 23 ASSUME CS:CODE, DS:DC, ES:DC + 24 + 25 ; Suffix A means address of operands in SI and DI + 26 ; Suffix C means first operand is FAC, second is at [DI] (SI smashed) + 27 ; Suffix E means first operand is at [SI], second is FAC (DI smashed) + 28 ; Suffix G means first operand is floating temp, second is FAC (SI and DI hit) + 29 + 30 0000 $FEXC: + 31 0000 BE 0000 E MOV SI,OFFSET DC:$AC + 32 0003 EB 06 JMP SHORT $FEXA + 33 0005 $FEXG: + 34 0005 E8 0000 E CALL $GTMP + 35 0008 $FEXE: + 36 0008 BF 0000 E MOV DI,OFFSET DC:$AC + 37 000B $FEXA: + 38 000B E8 0000 E CALL $SAVREG + 39 000E 33 C0 XOR AX,AX + 40 0010 A2 0002 R MOV [FLAG],AL ;Set sign positive, no mul or div needed yet + 41 0013 A3 0000 R MOV [POWERCNT],AX + 42 0016 8B 45 02 MOV AX,[DI+2] ;Get sign and exponent of Y + 43 0019 0A E4 OR AH,AH ;Is Y zero? + 44 001B 74 3D JZ ONE + 45 001D 8B 54 02 MOV DX,[SI+2] + 46 0020 0A F6 OR DH,DH ;Is X zero? + 47 0022 74 43 JZ ZERCHK + 48 0024 FF 34 PUSH [SI] ;Save the rest of X + 49 0026 8B 0D MOV CX,[DI] ;Get the rest of Y + 50 0028 89 0E 0000 E MOV [$TEMP],CX ;Save Y in TEMP + 51 002C A3 0002 E MOV [$TEMP+2],AX + 52 002F 8B DF MOV BX,DI + 53 0031 9A 0000 ---- E CALL $FIX + 54 0036 80 FC 90 CMP AH,80H+16 ;ABS(Y) >= 2^16? + + +INVOL - Involution operator Macro-86 %1(12) 1:7:38 13-Nov-81 Page 1-2 + + + + 55 0039 76 3B JBE SMALLPOWER + 56 003B 0A D2 OR DL,DL ;X < 0? + 57 003D 79 69 JNS LOGPOWER + 58 003F 80 FC 98 CMP AH,80H+24 ;ABS(Y) >= 2^24? + 59 0042 77 2F JA ARGERR ;If so, can't tell if odd - error! + 60 0044 3A 0E FFFD E CMP CL,[$FAC-3] ;Does INT(Y) = Y? (Other 24 bits must be =) + 61 0048 75 29 JNZ ARGERR + 62 004A 80 EC 91 SUB AH,80H+17 ;Get shift count range 0-7 + 63 004D 86 CC XCHG CL,AH + 64 004F D2 E4 SHL AH,CL ;LSB of Y in bit 7, to tell us even or odd + 65 0051 88 26 0002 R MOV [FLAG],AH ;Use it as sign of result + 66 0055 80 E2 7F AND DL,7FH ;Make X positive + 67 0058 EB 4E JMP SHORT LOGPOWER + 68 + 69 005A ONE: + 70 005A C7 06 0000 E 0000 MOV [$AC],0 + 71 0060 C7 06 0002 E 8100 MOV [$AC+2],8100H ;Jam floating one into FAC + 72 0066 C3 RET: RET + 73 + 74 0067 ZERCHK: + 75 0067 C6 06 0000 E 00 MOV [$FAC],0 ;Put a zero in FAC + 76 006C 0A C0 OR AL,AL ;Is power negative? + 77 006E 79 F6 JNS RET + 78 0070 E9 0000 E JMP $DIV0 ;If so, that's 1/0 - divide zero error + 79 + 80 0073 E9 0000 E ARGERR: JMP $ERC_FC ;Illegal function call + 81 + 82 0076 SMALLPOWER: + 83 0076 80 FC 80 CMP AH,80H ;Y < 1? + 84 0079 76 1A JBE ZEROPWR + 85 007B B1 90 MOV CL,80H+16 + 86 007D 2A CC SUB CL,AH ;Shift count to make Y integer + 87 007F 8A F8 MOV BH,AL + 88 0081 8A DD MOV BL,CH ;Mantissa of Y in BX + 89 0083 80 CF 80 OR BH,80H ;Set implied bit + 90 0086 D3 EB SHR BX,CL ;BX = Y as integer + 91 0088 89 1E 0000 R MOV [POWERCNT],BX + 92 008C 0A C0 OR AL,AL ;Y < 0? + 93 008E 79 05 JNS ZEROPWR + 94 0090 80 0E 0002 R 02 OR [FLAG],2 ;Since power is negative, we'll need to invert + 95 0095 ZEROPWR: + 96 0095 52 PUSH DX ;Save high half of X + 97 0096 BE 0000 E MOV SI,OFFSET DC:$TEMP + 98 0099 BF 0000 E MOV DI,OFFSET DC:$AC + 99 009C E8 0000 E CALL $SSUB ;FAC = Y - INT(Y) + 100 009F BE 0000 E MOV SI,OFFSET DC:$AC + 101 00A2 BF 0000 E MOV DI,OFFSET DC:$TEMP + 102 00A5 A5 MOVSW ;Move result back to TEMP + 103 00A6 A5 MOVSW + 104 00A7 5A POP DX + 105 00A8 LOGPOWER: + 106 00A8 58 POP AX ;X now in DX:AX + 107 00A9 80 3E 0003 E 00 CMP BYTE PTR [$TEMP+3],0 ;Is fraction part zero? + 108 00AE 74 21 JZ MULPOWER + + +INVOL - Involution operator Macro-86 %1(12) 1:7:38 13-Nov-81 Page 1-3 + + + + 109 00B0 50 PUSH AX + 110 00B1 52 PUSH DX ;Save X on stack + 111 00B2 A3 0000 E MOV [$AC],AX + 112 00B5 89 16 0002 E MOV [$AC+2],DX ;And put in FAC for polynomial evaluation + 113 00B9 E8 0000 E CALL $LOG2 ;Take log base 2 + 114 00BC BE 0000 E MOV SI,OFFSET DC:$AC + 115 00BF BF 0000 E MOV DI,OFFSET DC:$TEMP + 116 00C2 E8 0000 E CALL $SMUL ;FAC = Y * LOG2(X) + 117 00C5 E8 0000 E CALL $EXP2 ;FAC = 2^(Y*LOG2(X)) + 118 00C8 5A POP DX + 119 00C9 58 POP AX ;Restore X to DX:AX + 120 00CA 80 0E 0002 R 01 OR [FLAG],1 ;Multiplication by integer part will be needed + 121 00CF EB 03 JMP SHORT MULCHK + 122 + 123 00D1 MULPOWER: + 124 00D1 E8 005A R CALL ONE ;Put a one in FAC as result of fraction part + 125 00D4 MULCHK: + 126 00D4 8B 0E 0000 R MOV CX,[POWERCNT] + 127 00D8 E3 2B JCXZ SETSIGN + 128 00DA BE 0000 E MOV SI,OFFSET DC:$AC + 129 00DD BF 0000 E MOV DI,OFFSET DC:$TEMP + 130 00E0 A5 MOVSW ;Copy result of fraction part to TEMP + 131 00E1 A5 MOVSW + 132 00E2 A3 0000 E MOV [$ARG],AX + 133 00E5 89 16 0002 E MOV [$ARG+2],DX ;Put X in ARG + 134 00E9 E8 010F R CALL XTON ;Raise ARG to CX power + 135 00EC A0 0002 R MOV AL,[FLAG] + 136 00EF A8 03 TEST AL,3 ;Need to multiply or divide? + 137 00F1 74 12 JZ SETSIGN + 138 00F3 BF 0000 E MOV DI,OFFSET DC:$AC + 139 00F6 BE 0000 E MOV SI,OFFSET DC:$TEMP + 140 00F9 A8 02 TEST AL,2 ;Need to divide? + 141 00FB 75 05 JNZ POSTDIV + 142 00FD E8 0000 E CALL $SMUL + 143 0100 EB 03 JMP SHORT SETSIGN + 144 + 145 0102 POSTDIV: + 146 0102 E8 0000 E CALL $SDIV + 147 0105 SETSIGN: + 148 0105 A0 0002 R MOV AL,[FLAG] + 149 0108 24 80 AND AL,80H ;Mask to sign bit + 150 010A 08 06 FFFF E OR [$FAC-1],AL ;Set sign of result + 151 010E C3 DONE: RET + 152 + 153 010F XTON: ;Raise $ARG to CX power by repeat multiplication + 154 010F E8 005A R CALL ONE ;Put 1 in FAC + 155 0112 INTPWR: + 156 0112 D1 E9 SHR CX,1 ;Need to multiply by this power? + 157 0114 73 0B JNC SQUARE + 158 0116 51 PUSH CX + 159 0117 BE 0000 E MOV SI,OFFSET DC:$ARG + 160 011A BF 0000 E MOV DI,OFFSET DC:$AC + 161 011D E8 0000 E CALL $SMUL + 162 0120 59 POP CX + + +INVOL - Involution operator Macro-86 %1(12) 1:7:38 13-Nov-81 Page 1-4 + + + + 163 0121 SQUARE: + 164 0121 E3 EB JCXZ DONE + 165 0123 51 PUSH CX + 166 0124 FF 36 0000 E PUSH [$AC] + 167 0128 FF 36 0002 E PUSH [$AC+2] + 168 012C BE 0000 E MOV SI,OFFSET DC:$ARG + 169 012F 8B FE MOV DI,SI + 170 0131 E8 0000 E CALL $SMUL ;Square argument + 171 0134 BE 0000 E MOV SI,OFFSET DC:$AC + 172 0137 BF 0000 E MOV DI,OFFSET DC:$ARG + 173 013A A5 MOVSW + 174 013B A5 MOVSW ;And move it back to ARG + 175 013C 8F 06 0002 E POP [$AC+2] + 176 0140 8F 06 0000 E POP [$AC] ;Restore power being built in FAC + 177 0144 59 POP CX + 178 0145 EB CB JMP INTPWR + 179 + 180 0147 CODE ENDS + 181 END + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +INVOL - Involution operator Macro-86 %1(12) 1:7:38 13-Nov-81 Symbols-1 + + + +Segments and groups: + + N a m e Size align combine class + +CODE . . . . . . . . . . . . . . 0147 BYTE PUBLIC 'CODE' +DC . . . . . . . . . . . . . . . GROUP + DATA . . . . . . . . . . . . . . 0003 WORD PUBLIC 'DATA' + +Symbols: + + N a m e Type Value Attr + +ARGERR . . . . . . . . . . . . . L NEAR 0073 CODE +DONE . . . . . . . . . . . . . . L NEAR 010E CODE +FLAG . . . . . . . . . . . . . . L BYTE 0002 DATA +INTPWR . . . . . . . . . . . . . L NEAR 0112 CODE +LOGPOWER . . . . . . . . . . . . L NEAR 00A8 CODE +MULCHK . . . . . . . . . . . . . L NEAR 00D4 CODE +MULPOWER . . . . . . . . . . . . L NEAR 00D1 CODE +ONE. . . . . . . . . . . . . . . L NEAR 005A CODE +POSTDIV. . . . . . . . . . . . . L NEAR 0102 CODE +POWERCNT . . . . . . . . . . . . L WORD 0000 DATA +RET. . . . . . . . . . . . . . . L NEAR 0066 CODE +SETSIGN. . . . . . . . . . . . . L NEAR 0105 CODE +SMALLPOWER . . . . . . . . . . . L NEAR 0076 CODE +SQUARE . . . . . . . . . . . . . L NEAR 0121 CODE +XTON . . . . . . . . . . . . . . L NEAR 010F CODE +ZERCHK . . . . . . . . . . . . . L NEAR 0067 CODE +ZEROPWR. . . . . . . . . . . . . L NEAR 0095 CODE +$AC. . . . . . . . . . . . . . . V WORD 0000 DATA External +$ARG . . . . . . . . . . . . . . V WORD 0000 DATA External +$DIV0. . . . . . . . . . . . . . L NEAR 0000 CODE External +$ERC_FC. . . . . . . . . . . . . L NEAR 0000 CODE External +$EXP2. . . . . . . . . . . . . . L NEAR 0000 CODE External +$FAC . . . . . . . . . . . . . . V BYTE 0000 DATA External +$FEXA. . . . . . . . . . . . . . L NEAR 000B CODE Global +$FEXC. . . . . . . . . . . . . . L NEAR 0000 CODE Global +$FEXE. . . . . . . . . . . . . . L NEAR 0008 CODE Global +$FEXG. . . . . . . . . . . . . . L NEAR 0005 CODE Global +$FIX . . . . . . . . . . . . . . L FAR 0000 CODE External +$GTMP. . . . . . . . . . . . . . L NEAR 0000 CODE External +$LOG2. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SAVREG. . . . . . . . . . . . . L NEAR 0000 CODE External +$SDIV. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SMUL. . . . . . . . . . . . . . L NEAR 0000 CODE External +$SSUB. . . . . . . . . . . . . . L NEAR 0000 CODE External +$TEMP. . . . . . . . . . . . . . V WORD 0000 DATA External + +Warning Severe +Errors Errors +0 0 + + + + + diff --git a/3_source_code/BASLIB-86/INVOL.ASM b/3_source_code/BASLIB-86/INVOL.ASM new file mode 100644 index 0000000..1afb417 --- /dev/null +++ b/3_source_code/BASLIB-86/INVOL.ASM @@ -0,0 +1,181 @@ + TITLE INVOL - Involution operator + +DATA SEGMENT WORD PUBLIC 'DATA' + + EXTRN $AC:WORD, $ARG:WORD, $FAC:BYTE, $TEMP:WORD + +POWERCNT DW ? +FLAG DB ? + +DATA ENDS + + +DC GROUP DATA + + +CODE SEGMENT BYTE PUBLIC 'CODE' + + PUBLIC $FEXA, $FEXC, $FEXE, $FEXG + + EXTRN $SAVREG:NEAR, $SMUL:NEAR, $GTMP:NEAR, $LOG2:NEAR, $EXP2:NEAR + EXTRN $SDIV:NEAR, $SSUB:NEAR, $FIX:FAR, $DIV0:NEAR, $ERC_FC:NEAR + + ASSUME CS:CODE, DS:DC, ES:DC + +; Suffix A means address of operands in SI and DI +; Suffix C means first operand is FAC, second is at [DI] (SI smashed) +; Suffix E means first operand is at [SI], second is FAC (DI smashed) +; Suffix G means first operand is floating temp, second is FAC (SI and DI hit) + +$FEXC: + MOV SI,OFFSET DC:$AC + JMP SHORT $FEXA +$FEXG: + CALL $GTMP +$FEXE: + MOV DI,OFFSET DC:$AC +$FEXA: + CALL $SAVREG + XOR AX,AX + MOV [FLAG],AL ;Set sign positive, no mul or div needed yet + MOV [POWERCNT],AX + MOV AX,[DI+2] ;Get sign and exponent of Y + OR AH,AH ;Is Y zero? + JZ ONE + MOV DX,[SI+2] + OR DH,DH ;Is X zero? + JZ ZERCHK + PUSH [SI] ;Save the rest of X + MOV CX,[DI] ;Get the rest of Y + MOV [$TEMP],CX ;Save Y in TEMP + MOV [$TEMP+2],AX + MOV BX,DI + CALL $FIX + CMP AH,80H+16 ;ABS(Y) >= 2^16? + JBE SMALLPOWER + OR DL,DL ;X < 0? + JNS LOGPOWER + CMP AH,80H+24 ;ABS(Y) >= 2^24? + JA ARGERR ;If so, can't tell if odd - error! + CMP CL,[$FAC-3] ;Does INT(Y) = Y? (Other 24 bits must be =) + JNZ ARGERR + SUB AH,80H+17 ;Get shift count range 0-7 + XCHG CL,AH + SHL AH,CL ;LSB of Y in bit 7, to tell us even or odd + MOV [FLAG],AH ;Use it as sign of result + AND DL,7FH ;Make X positive + JMP SHORT LOGPOWER + +ONE: + MOV [$AC],0 + MOV [$AC+2],8100H ;Jam floating one into FAC +RET: RET + +ZERCHK: + MOV [$FAC],0 ;Put a zero in FAC + OR AL,AL ;Is power negative? + JNS RET + JMP $DIV0 ;If so, that's 1/0 - divide zero error + +ARGERR: JMP $ERC_FC ;Illegal function call + +SMALLPOWER: + CMP AH,80H ;Y < 1? + JBE ZEROPWR + MOV CL,80H+16 + SUB CL,AH ;Shift count to make Y integer + MOV BH,AL + MOV BL,CH ;Mantissa of Y in BX + OR BH,80H ;Set implied bit + SHR BX,CL ;BX = Y as integer + MOV [POWERCNT],BX + OR AL,AL ;Y < 0? + JNS ZEROPWR + OR [FLAG],2 ;Since power is negative, we'll need to invert +ZEROPWR: + PUSH DX ;Save high half of X + MOV SI,OFFSET DC:$TEMP + MOV DI,OFFSET DC:$AC + CALL $SSUB ;FAC = Y - INT(Y) + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$TEMP + MOVSW ;Move result back to TEMP + MOVSW + POP DX +LOGPOWER: + POP AX ;X now in DX:AX + CMP BYTE PTR [$TEMP+3],0 ;Is fraction part zero? + JZ MULPOWER + PUSH AX + PUSH DX ;Save X on stack + MOV [$AC],AX + MOV [$AC+2],DX ;And put in FAC for polynomial evaluation + CALL $LOG2 ;Take log base 2 + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$TEMP + CALL $SMUL ;FAC = Y * LOG2(X) + CALL $EXP2 ;FAC = 2^(Y*LOG2(X)) + POP DX + POP AX ;Restore X to DX:AX + OR [FLAG],1 ;Multiplication by integer part will be needed + JMP SHORT MULCHK + +MULPOWER: + CALL ONE ;Put a one in FAC as result of fraction part +MULCHK: + MOV CX,[POWERCNT] + JCXZ SETSIGN + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$TEMP + MOVSW ;Copy result of fraction part to TEMP + MOVSW + MOV [$ARG],AX + MOV [$ARG+2],DX ;Put X in ARG + CALL XTON ;Raise ARG to CX power + MOV AL,[FLAG] + TEST AL,3 ;Need to multiply or divide? + JZ SETSIGN + MOV DI,OFFSET DC:$AC + MOV SI,OFFSET DC:$TEMP + TEST AL,2 ;Need to divide? + JNZ POSTDIV + CALL $SMUL + JMP SHORT SETSIGN + +POSTDIV: + CALL $SDIV +SETSIGN: + MOV AL,[FLAG] + AND AL,80H ;Mask to sign bit + OR [$FAC-1],AL ;Set sign of result +DONE: RET + +XTON: ;Raise $ARG to CX power by repeat multiplication + CALL ONE ;Put 1 in FAC +INTPWR: + SHR CX,1 ;Need to multiply by this power? + JNC SQUARE + PUSH CX + MOV SI,OFFSET DC:$ARG + MOV DI,OFFSET DC:$AC + CALL $SMUL + POP CX +SQUARE: + JCXZ DONE + PUSH CX + PUSH [$AC] + PUSH [$AC+2] + MOV SI,OFFSET DC:$ARG + MOV DI,SI + CALL $SMUL ;Square argument + MOV SI,OFFSET DC:$AC + MOV DI,OFFSET DC:$ARG + MOVSW + MOVSW ;And move it back to ARG + POP [$AC+2] + POP [$AC] ;Restore power being built in FAC + POP CX + JMP INTPWR + +CODE ENDS + END