├── .github └── workflows │ └── main.yml ├── .gitignore ├── LICENSE.txt ├── Makefile ├── README.md ├── bdos.asm └── ccp.asm /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ main ] 6 | pull_request: 7 | branches: [ main ] 8 | jobs: 9 | build: 10 | runs-on: ubuntu-latest 11 | strategy: 12 | fail-fast: false 13 | 14 | steps: 15 | - uses: actions/checkout@v4 16 | 17 | - name: apt-get update 18 | run: sudo apt-get update 19 | 20 | # its a total mess to install tex, but AS needs it 21 | - name: install texlive 22 | run: sudo apt-get install texlive 23 | 24 | - name: install pdflatex 25 | run: sudo apt-get install texlive-latex-base 26 | 27 | - name: install texlive-fonts-extra 28 | run: sudo apt-get install texlive-fonts-extra 29 | 30 | - name: install texlive-fonts-recommended 31 | run: sudo apt-get install texlive-fonts-recommended 32 | 33 | - name: install texlive-latex-extra 34 | run: sudo apt-get install texlive-latex-extra 35 | 36 | - name: install texlive-lang-german 37 | run: sudo apt-get install texlive-lang-german 38 | 39 | # get AS 40 | - name: download AS 41 | run: wget http://john.ccac.rwth-aachen.de:8000/ftp/as/source/c_version/asl-current.tar.gz 42 | 43 | - name: extract AS 44 | run: tar zxvf asl-current.tar.gz 45 | 46 | # we're linux 47 | - name: copy defs file 48 | run: cd asl-current; cp Makefile.def-samples/Makefile.def-x86_64-unknown-linux Makefile.def 49 | 50 | # make the AS assembler 51 | - name: make AS 52 | run: cd asl-current; make binaries; sudo make install 53 | 54 | # make CP/M 55 | - name: make cp/m 56 | run: make 57 | 58 | - name: bdos artifact 59 | uses: actions/upload-artifact@v4 60 | with: 61 | name: bdos-44k.bin 62 | path: bdos-44k.bin 63 | 64 | - name: bdos lst 65 | uses: actions/upload-artifact@v4 66 | with: 67 | name: bdos-44k.lst 68 | path: bdos-44k.lst 69 | 70 | - name: ccp artifact 71 | uses: actions/upload-artifact@v4 72 | with: 73 | name: ccp-44k.bin 74 | path: ccp-44k.bin 75 | 76 | - name: ccp lst 77 | uses: actions/upload-artifact@v4 78 | with: 79 | name: ccp-44k.lst 80 | path: ccp-44k.lst 81 | 82 | - name: install cpmtools 83 | run: sudo apt-get install cpmtools 84 | 85 | - name: make image file 86 | run: dd if=/dev/zero of=cpm.img bs=720k count=1 87 | 88 | - name: format image to cpm 89 | run: mkfs.cpm -f cpm86-720 cpm.img 90 | 91 | - name: ls 92 | run: ls -lat -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.p 3 | *.bin 4 | *.lst 5 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | The license to CP/M and its derivatives was made more free on 2022-07-07. 2 | The relevant email from Bryan Sparks, below, is quoted from the Unofficial 3 | CP/M Web Site: 4 | http://www.cpm.z80.de/license.html 5 | 6 | 7 | From: Bryan Sparks <*****@drycanyon.com> Thu, Jul 7, 8:04 AM 8 | To: Scott Chapman <******@mischko.com> 9 | 10 | Hmmm. Well, what you describe wasn't my intent but I get that this was unclear. 11 | It was also some time ago. 12 | 13 | Not sure how to "officially" clear this up except to modify the original email content 14 | removing the constraint to the website/group that was mentioned. So, perhaps, this 15 | will suffice: 16 | 17 | "Let this paragraph represent a right to use, distribute, modify, enhance, and otherwise 18 | make available in a nonexclusive manner CP/M and its derivatives. This right comes from 19 | the company, DRDOS, Inc.'s purchase of Digital Research, the company and all assets, 20 | dating back to the mid-1990's. DRDOS, Inc. and I, Bryan Sparks, President of DRDOS, 21 | Inc. as its representative, is the owner of CP/M and the successor in interest of 22 | Digital Research assets." 23 | 24 | It's a bit clumsy but this may get the intent cleared and authority upon which it is 25 | granted. 26 | 27 | Thanks for the email. 28 | 29 | Bryan 30 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Example Makefile for CP/M 2.2 bdos and ccp using Macro Assembler AS 2 | 3 | all: bdos-44k.bin bdos-44k.lst ccp-44k.bin ccp-44k.lst 4 | 5 | bdos-44k.p bdos-44k.lst: bdos.asm 6 | asl -D origin=9c00h -o bdos-44k.p -L -OLIST bdos-44k.lst bdos.asm 7 | 8 | bdos-44k.bin: bdos-44k.p 9 | p2bin -l '$$00' -r '$$9c00-$$a9ff' bdos-44k.p 10 | 11 | ccp-44k.p ccp-44k.lst: ccp.asm 12 | asl -D origin=9400h -o ccp-44k.p -L -OLIST ccp-44k.lst ccp.asm 13 | 14 | ccp-44k.bin: ccp-44k.p 15 | p2bin -l '$$00' -r '$$9400-$$9bff' ccp-44k.p 16 | 17 | clean: 18 | rm -f *.p *.bin *.lst 19 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![CI](https://github.com/brouhaha/cpm22/actions/workflows/main.yml/badge.svg)](https://github.com/brouhaha/cpm22/actions/workflows/main.yml) 2 | 3 | # cpm22 - source code for CP/M 2.2 CCP and BDOS 4 | 5 | Hosted at the 6 | [cpm22 Github repository](https://github.com/brouhaha/cpm22/). 7 | 8 | ## Introduction 9 | 10 | Introduced in 1974, CP/M by Digital Research was one of the first 11 | microcomputer operating systems that was not tied to a single computer 12 | vendor. It could be adapted to run on almost any 8080 or Z80 13 | microcomputer that had at least 16KB of RAM starting at address 0000h. 14 | 15 | Originally much of CP/M was written in the PL/M programming language. 16 | With the introduction of CP/M 2.0, the command processor (CCP) and kernel 17 | (BDOS) were rewritten in 8080 assembly language. 18 | 19 | ## Building 20 | 21 | The Digital Research ASM80 assembler allowed code to be written with 22 | mulitple assembly language instructions per line, separated by an 23 | exclamation mark ("!"). Although a semicolon (";") was used to introduce 24 | a comment, an exclamation mark in a comment would start a new instruction. 25 | There are two problems with this syntax: 26 | 27 | * This syntax makes the source code rather difficult to read, when one 28 | is accustomed to normal assembler syntax. 29 | 30 | * Few if any assemblers other than DRI's ASM80 support this syntax. 31 | 32 | This repository contains the CP/M 2.2 CCP and BDOS source code, reformatted 33 | to cross-assemble with Macro Assembler AS: 34 | 35 | http://john.ccac.rwth-aachen.de:8000/as/ 36 | 37 | The source code has been verified to assemble to the exact binary present 38 | on several actual CP/M 2.2 disks, with the exception of the six-byte serial 39 | numbers present in the CCP and BDOS. 40 | 41 | It is likely that with only minor changes, the source code could be 42 | assembled using other assemblers (native or cross). 43 | -------------------------------------------------------------------------------- /bdos.asm: -------------------------------------------------------------------------------- 1 | ; Reformatted and converted for cross-assembly by Macro Assembler AS 2 | ; Eric Smith 2018-01-24 3 | ; from original source os3bdos.asm from 4 | ; http://www.cpm.z80.de/download/cpm2-plm.zip 5 | ; includes Digital Research CP/M V2.2 Patch 01 (cpm22pat.01) from 6 | ; http://www.cpm.z80.de/download/cpm22pat.zip 7 | 8 | ; Changes: 9 | ; multiple instructions per line split to separate lines 10 | ; dollar sign in labels replaced by underscore 11 | ; dollar sign (as digit separator) in binary constants removed 12 | ; no colons for labels for equates 13 | ; single quotes around strings replaced with double quotes 14 | ; true and false replaced with _true and _false 15 | ; eliminated equates for 8080 registers, added comments introduced with % 16 | ; replaced "not", "and" operators with "~", "&" 17 | ; removed empty comments 18 | ; added ifdef origin to allow origin to be specified from command line 19 | ; added commments about serial number 20 | 21 | .cpu 8080 22 | 23 | patch1 equ 1 24 | 25 | 26 | title "Bdos Interface, Bdos, Version 2.2 Feb, 1980" 27 | ;***************************************************************** 28 | ;***************************************************************** 29 | ;** ** 30 | ;** B a s i c D i s k O p e r a t i n g S y s t e m ** 31 | ;** I n t e r f a c e M o d u l e ** 32 | ;** ** 33 | ;***************************************************************** 34 | ;***************************************************************** 35 | ; 36 | ; Copyright (c) 1978, 1979, 1980 37 | ; Digital Research 38 | ; Box 579, Pacific Grove 39 | ; California 40 | ; 41 | ; 42 | ; 20 january 1980 43 | ; 44 | ; 45 | on equ 0ffffh 46 | off equ 00000h 47 | test equ off 48 | 49 | ifdef origin 50 | org origin 51 | else 52 | if test 53 | org 0dc00h 54 | else 55 | org 0800h 56 | endif 57 | endif 58 | ; bios value defined at end of module 59 | 60 | ssize equ 24 ;24 level stack 61 | 62 | ; low memory locations 63 | reboot equ 0000h ;reboot system 64 | ioloc equ 0003h ;i/o byte location 65 | bdosa equ 0006h ;address field of jmp BDOS 66 | 67 | ; bios access constants 68 | bootf set bios+3*0 ;cold boot function 69 | wbootf set bios+3*1 ;warm boot function 70 | constf set bios+3*2 ;console status function 71 | coninf set bios+3*3 ;console input function 72 | conoutf set bios+3*4 ;console output function 73 | listf set bios+3*5 ;list output function 74 | punchf set bios+3*6 ;punch output function 75 | readerf set bios+3*7 ;reader input function 76 | homef set bios+3*8 ;disk home function 77 | seldskf set bios+3*9 ;select disk function 78 | settrkf set bios+3*10 ;set track function 79 | setsecf set bios+3*11 ;set sector function 80 | setdmaf set bios+3*12 ;set dma function 81 | readf set bios+3*13 ;read disk function 82 | writef set bios+3*14 ;write disk function 83 | liststf set bios+3*15 ;list status function 84 | sectran set bios+3*16 ;sector translate 85 | 86 | ; equates for non graphic characters 87 | ctlc equ 03h ;control c 88 | ctle equ 05h ;physical eol 89 | ctlh equ 08h ;backspace 90 | ctlp equ 10h ;prnt toggle 91 | ctlr equ 12h ;repeat line 92 | ctls equ 13h ;stop/start screen 93 | ctlu equ 15h ;line delete 94 | ctlx equ 18h ;=ctl-u 95 | ctlz equ 1ah ;end of file 96 | rubout equ 7fh ;char delete 97 | tab equ 09h ;tab char 98 | cr equ 0dh ;carriage return 99 | lf equ 0ah ;line feed 100 | ctl equ 5eh ;up arrow 101 | 102 | ; serial number (not documented in original DRI source file) 103 | db 0 ; OEM number, low byte 104 | db 0 ; CP/M version, 16h = 2.2 105 | db 0 ; OEM number, high byte 106 | db 0,0,0 ; serial number, big-endian 107 | 108 | ; enter here from the user's program with function number in c, 109 | ; and information address in d,e 110 | jmp bdose ;past parameter block 111 | 112 | ; ************************************************ 113 | ; *** relative locations 0009 - 000e *** 114 | ; ************************************************ 115 | pererr: dw persub ;permanent error subroutine 116 | selerr: dw selsub ;select error subroutine 117 | roderr: dw rodsub ;ro disk error subroutine 118 | roferr: dw rofsub ;ro file error subroutine 119 | 120 | 121 | bdose: ;arrive here from user programs 122 | xchg ;info=DE, DE=info 123 | shld info 124 | xchg 125 | mov a,e ;linfo = low(info) - don't equ 126 | sta linfo 127 | lxi h,0 ;return value defaults to 0000 128 | shld aret 129 | ;save user's stack pointer, set to local stack 130 | dad sp ;entsp = stackptr 131 | shld entsp 132 | lxi sp,lstack ;local stack setup 133 | xra a ;fcbdsk,resel=false 134 | sta fcbdsk 135 | sta resel 136 | lxi h,goback ;return here after all functions 137 | push h ;jmp goback equivalent to ret 138 | mov a,c ;skip if invalid # 139 | cpi nfuncs 140 | rnc 141 | mov c,e ;possible output character to C 142 | lxi h,functab ;DE=func, HL=.ciotab 143 | mov e,a 144 | mvi d,0 145 | dad d ;DE=functab(func) 146 | dad d 147 | mov e,m 148 | inx h 149 | mov d,m 150 | lhld info ;info in DE for later xchg 151 | xchg ;dispatched 152 | pchl 153 | 154 | ; dispatch table for functions 155 | functab: 156 | dw wbootf, func1, func2, func3 157 | dw punchf, listf, func6, func7 158 | dw func8, func9, func10,func11 159 | diskf equ ($-functab)/2 ;disk funcs 160 | dw func12,func13,func14,func15 161 | dw func16,func17,func18,func19 162 | dw func20,func21,func22,func23 163 | dw func24,func25,func26,func27 164 | dw func28,func29,func30,func31 165 | dw func32,func33,func34,func35 166 | dw func36,func37,func38,func39 167 | dw func40 168 | nfuncs equ ($-functab)/2 169 | 170 | 171 | ; error subroutines 172 | persub: ;report permanent error 173 | lxi h,permsg ;to report the error 174 | call errflg 175 | cpi ctlc ;reboot if response is ctlc 176 | jz reboot 177 | ret ;and ignore the error 178 | 179 | selsub: ;report select error 180 | lxi h,selmsg ;wait console before boot 181 | jmp wait_err 182 | ; 183 | rodsub: ;report write to read/only disk 184 | lxi h,rodmsg ;wait console 185 | jmp wait_err 186 | ; 187 | rofsub: ;report read/only file 188 | lxi h,rofmsg ;drop through to wait for console 189 | ; 190 | wait_err: 191 | ;wait for response before boot 192 | call errflg 193 | jmp reboot 194 | 195 | ; error messages 196 | dskmsg: db "Bdos Err On " 197 | dskerr: db " : $" ;filled in by errflg 198 | permsg: db "Bad Sector$" 199 | selmsg: db "Select$" 200 | rofmsg: db "File " 201 | rodmsg: db "R/O$" 202 | 203 | 204 | errflg: 205 | ;report error to console, message address in HL 206 | push h ;stack mssg address, new line 207 | call crlf 208 | lda curdsk ;current disk name 209 | adi 'A' 210 | sta dskerr 211 | lxi b,dskmsg ;the error message 212 | call print 213 | pop b ;error mssage tail 214 | call print 215 | ;jmp conin ;to get the input character 216 | ;(drop through to conin) 217 | ;ret 218 | 219 | 220 | ; console handlers 221 | conin: 222 | ;read console character to A 223 | lxi h,kbchar 224 | mov a,m 225 | mvi m,0 226 | ora a 227 | rnz 228 | ;no previous keyboard character ready 229 | jmp coninf ;get character externally 230 | ;ret 231 | 232 | conech: 233 | ;read character with echo 234 | call conin ;echo character? 235 | call echoc 236 | rc 237 | ;character must be echoed before return 238 | push psw 239 | mov c,a 240 | call tabout 241 | pop psw 242 | ret ;with character in A 243 | 244 | echoc: 245 | ;echo character if graphic 246 | ;cr, lf, tab, or backspace 247 | cpi cr ;carriage return? 248 | rz 249 | cpi lf ;line feed? 250 | rz 251 | cpi tab ;tab? 252 | rz 253 | cpi ctlh ;backspace? 254 | rz 255 | cpi ' ' ;carry set if not graphic 256 | ret 257 | 258 | conbrk: ;check for character ready 259 | lda kbchar ;skip if active kbchar 260 | ora a 261 | jnz conb1 262 | ;no active kbchar, check external break 263 | call constf ;return if no char ready 264 | ani 1 265 | rz 266 | ;character ready, read it 267 | call coninf ;to A 268 | cpi ctls ;check stop screen function 269 | jnz conb0 270 | ;found ctls, read next character 271 | call coninf ;to A 272 | cpi ctlc ;ctlc implies re-boot 273 | jz reboot 274 | ;not a reboot, act as if nothing has happened 275 | xra a ;with zero in accumulator 276 | ret 277 | conb0: ;character in accum, save it 278 | sta kbchar 279 | conb1: ;return with true set in accumulator 280 | mvi a,1 281 | ret 282 | 283 | conout: 284 | ;compute character position/write console char from C 285 | ;compcol = true if computing column position 286 | lda compcol 287 | ora a 288 | jnz compout 289 | ;write the character, then compute the column 290 | ;write console character from C 291 | push b ;check for screen stop function 292 | call conbrk 293 | pop b ;recall/save character 294 | push b 295 | call conoutf ;externally, to console 296 | pop b ;recall/save character 297 | push b 298 | ;may be copying to the list device 299 | lda listcp ;to printer, if so 300 | ora a 301 | cnz listf 302 | pop b ;recall the character 303 | compout: 304 | mov a,c ;recall the character 305 | ;and compute column position 306 | lxi h,column ;A = char, HL = .column 307 | cpi rubout ;no column change if nulls 308 | rz 309 | inr m ;column = column + 1 310 | cpi ' ' ;return if graphic 311 | rnc 312 | ;not graphic, reset column position 313 | dcr m ;column = column - 1 314 | mov a,m ;return if at zero 315 | ora a 316 | rz 317 | ;not at zero, may be backspace or end line 318 | mov a,c ;character back to A 319 | cpi ctlh 320 | jnz notbacksp 321 | ;backspace character 322 | dcr m ;column = column - 1 323 | ret 324 | notbacksp: 325 | ;not a backspace character, eol? 326 | cpi lf ;return if not 327 | rnz 328 | ;end of line, column = 0 329 | mvi m,0 ;column = 0 330 | ret 331 | 332 | ctlout: 333 | ;send C character with possible preceding up-arrow 334 | mov a,c ;cy if not graphic (or special case) 335 | call echoc 336 | jnc tabout ;skip if graphic, tab, cr, lf, or ctlh 337 | ;send preceding up arrow 338 | push psw ;up arrow 339 | mvi c,ctl 340 | call conout 341 | pop psw ;becomes graphic letter 342 | ori 40h 343 | mov c,a ;ready to print 344 | ;(drop through to tabout) 345 | 346 | tabout: 347 | ;expand tabs to console 348 | mov a,c ;direct to conout if not 349 | cpi tab 350 | jnz conout 351 | ;tab encountered, move to next tab position 352 | tab0: 353 | mvi c,' ' ;another blank 354 | call conout 355 | lda column ;column mod 8 = 0 ? 356 | ani 111b 357 | jnz tab0 ;back for another if not 358 | ret 359 | 360 | 361 | backup: 362 | ;back-up one screen position 363 | call pctlh 364 | mvi c,' ' 365 | call conoutf 366 | ; (drop through to pctlh) 367 | pctlh: 368 | ;send ctlh to console without affecting column count 369 | mvi c,ctlh 370 | jmp conoutf 371 | ;ret 372 | 373 | crlfp: 374 | ;print #, cr, lf for ctlx, ctlu, ctlr functions 375 | ;then move to strtcol (starting column) 376 | mvi c,'#' 377 | call conout 378 | call crlf 379 | ;column = 0, move to position strtcol 380 | crlfp0: 381 | lda column 382 | lxi h,strtcol 383 | cmp m ;stop when column reaches strtcol 384 | rnc 385 | mvi c,' ' ;print blank 386 | call conout 387 | jmp crlfp0 388 | 389 | 390 | crlf: 391 | ;carriage return line feed sequence 392 | mvi c,cr 393 | call conout 394 | mvi c,lf 395 | jmp conout 396 | ;ret 397 | 398 | print: 399 | ;print message until M(BC) = '$' 400 | ldax b ;stop on $ 401 | cpi '$' 402 | rz 403 | ;more to print 404 | inx b ;char to C 405 | push b 406 | mov c,a 407 | call tabout ;another character printed 408 | pop b 409 | jmp print 410 | 411 | read: ;read to info address (max length, current length, buffer) 412 | lda column ;save start for ctl-x, ctl-h 413 | sta strtcol 414 | lhld info 415 | mov c,m 416 | inx h 417 | push h 418 | mvi b,0 419 | ;B = current buffer length, 420 | ;C = maximum buffer length, 421 | ;HL= next to fill - 1 422 | readnx: 423 | ;read next character, BC, HL active 424 | push b ;blen, cmax, HL saved 425 | push h 426 | readn0: 427 | call conin ;next char in A 428 | ani 7fh ;mask parity bit 429 | pop h ;reactivate counters 430 | pop b 431 | cpi cr ;end of line? 432 | jz readen 433 | cpi lf ;also end of line 434 | jz readen 435 | cpi ctlh ;backspace? 436 | jnz noth 437 | ;do we have any characters to back over? 438 | mov a,b 439 | ora a 440 | jz readnx 441 | ;characters remain in buffer, backup one 442 | dcr b ;remove one character 443 | lda column ;col > 0 444 | sta compcol 445 | ;compcol > 0 marks repeat as length compute 446 | jmp linelen ;uses same code as repeat 447 | noth: 448 | ;not a backspace 449 | cpi rubout ;rubout char? 450 | jnz notrub 451 | ;rubout encountered, rubout if possible 452 | mov a,b ;skip if len=0 453 | ora a 454 | jz readnx 455 | ;buffer has characters, resend last char 456 | mov a,m ;A = last char 457 | dcr b 458 | dcx h 459 | ;blen=blen-1, next to fill - 1 decremented 460 | jmp rdech1 ;act like this is an echo 461 | 462 | notrub: 463 | ;not a rubout character, check end line 464 | cpi ctle ;physical end line? 465 | jnz note 466 | ;yes, save active counters and force eol 467 | push b 468 | push h 469 | call crlf 470 | xra a ;start position = 00 471 | sta strtcol 472 | jmp readn0 ;for another character 473 | note: 474 | ;not end of line, list toggle? 475 | cpi ctlp ;skip if not ctlp 476 | jnz notp 477 | ;list toggle - change parity 478 | push h ;save next to fill - 1 479 | lxi h,listcp ;HL=.listcp flag 480 | mvi a,1 ;True-listcp 481 | sub m 482 | mov m,a ;listcp = not listcp 483 | pop h ;for another char 484 | jmp readnx 485 | notp: 486 | ;not a ctlp, line delete? 487 | cpi ctlx 488 | jnz notx 489 | pop h ;discard start position 490 | ;loop while column > strtcol 491 | backx: 492 | lda strtcol 493 | lxi h,column 494 | cmp m ;start again 495 | jnc read 496 | dcr m ;column = column - 1 497 | call backup ;one position 498 | jmp backx 499 | notx: 500 | ;not a control x, control u? 501 | ;not control-X, control-U? 502 | cpi ctlu ;skip if not 503 | jnz notu 504 | ;delete line (ctlu) 505 | call crlfp ;physical eol 506 | pop h ;discard starting position 507 | jmp read ;to start all over 508 | notu: 509 | ;not line delete, repeat line? 510 | cpi ctlr 511 | jnz notr 512 | linelen: 513 | ;repeat line, or compute line len (ctlh) 514 | ;if compcol > 0 515 | push b ;save line length 516 | call crlfp 517 | pop b 518 | pop h 519 | push h 520 | push b 521 | ;bcur, cmax active, beginning buff at HL 522 | rep0: 523 | mov a,b ;count len to 00 524 | ora a 525 | jz rep1 526 | inx h ;next to print 527 | mov c,m 528 | dcr b ;count length down 529 | push b 530 | push h 531 | call ctlout ;character echoed 532 | pop h ;recall remaining count 533 | pop b 534 | jmp rep0 ;for the next character 535 | rep1: 536 | ;end of repeat, recall lengths 537 | ;original BC still remains pushed 538 | push h ;save next to fill 539 | lda compcol ;>0 if computing length 540 | ora a 541 | jz readn0 ;for another char if so 542 | ;column position computed for ctlh 543 | lxi h,column ;diff > 0 544 | sub m 545 | sta compcol ;count down below 546 | ;move back compcol-column spaces 547 | backsp: 548 | ;move back one more space 549 | call backup ;one space 550 | lxi h,compcol 551 | dcr m 552 | jnz backsp 553 | jmp readn0 ;for next character 554 | notr: 555 | ;not a ctlr, place into buffer 556 | rdecho: 557 | inx h ;character filled to mem 558 | mov m,a 559 | inr b ;blen = blen + 1 560 | rdech1: 561 | ;look for a random control character 562 | push b ;active values saved 563 | push h 564 | mov c,a ;ready to print 565 | call ctlout ;may be up-arrow C 566 | pop h ;recall char 567 | pop b 568 | mov a,m 569 | cpi ctlc ;set flags for reboot test 570 | mov a,b ;move length to A 571 | jnz notc ;skip if not a control c 572 | cpi 1 ;control C, must be length 1 573 | jz reboot ;reboot if blen = 1 574 | ;length not one, so skip reboot 575 | notc: 576 | ;not reboot, are we at end of buffer? 577 | cmp c ;go for another if not 578 | jc readnx 579 | readen: 580 | ;end of read operation, store blen 581 | pop h ;M(current len) = B 582 | mov m,b 583 | mvi c,cr ;return carriage 584 | jmp conout 585 | ;ret 586 | func1: 587 | ;return console character with echo 588 | call conech 589 | jmp sta_ret 590 | ; 591 | func2 equ tabout 592 | ;write console character with tab expansion 593 | ; 594 | func3: 595 | ;return reader character 596 | call readerf 597 | jmp sta_ret 598 | 599 | ;func4: equated to punchf 600 | ;write punch character 601 | 602 | ;func5: equated to listf 603 | ;write list character 604 | ;write to list device 605 | 606 | func6: 607 | ;direct console i/o - read if 0ffh 608 | mov a,c ;0ffh => 00h, means input mode 609 | inr a 610 | jz dirinp 611 | inr a ;0feH in C for status 612 | jz constf 613 | ;direct output function 614 | jmp conoutf 615 | dirinp: 616 | call constf ;status check 617 | ora a ;skip, return 00 if not ready 618 | jz retmon 619 | ;character is ready, get it 620 | call coninf ;to A 621 | jmp sta_ret 622 | 623 | func7: 624 | ;return io byte 625 | lda ioloc 626 | jmp sta_ret 627 | 628 | func8: 629 | ;set i/o byte 630 | lxi h,ioloc 631 | mov m,c 632 | ret ;jmp goback 633 | 634 | func9: 635 | ;write line until $ encountered 636 | xchg ;was lhld info 637 | mov c,l ;BC=string address 638 | mov b,h 639 | jmp print ;out to console 640 | 641 | func10 equ read 642 | ;read a buffered console line 643 | 644 | func11: 645 | ;check console status 646 | call conbrk 647 | ;(drop through to sta_ret) 648 | sta_ret: 649 | ;store the A register to aret 650 | sta aret 651 | func_ret: ; 652 | ret ;jmp goback (pop stack for non cp/m functions) 653 | 654 | setlret1: 655 | ;set lret = 1 656 | mvi a,1 657 | jmp sta_ret 658 | 659 | 660 | 661 | ; data areas 662 | 663 | compcol:db 0 ;true if computing column position 664 | strtcol:db 0 ;starting column position after read 665 | column: db 0 ;column position 666 | listcp: db 0 ;listing toggle 667 | kbchar: db 0 ;initial key char = 00 668 | entsp: ds 2 ;entry stack pointer 669 | ds ssize*2 ;stack size 670 | lstack: 671 | ; end of Basic I/O System 672 | 673 | ;***************************************************************** 674 | ;***************************************************************** 675 | 676 | ; common values shared between bdosi and bdos 677 | usrcode:db 0 ;current user number 678 | curdsk: db 0 ;current disk number 679 | info: ds 2 ;information address 680 | aret: ds 2 ;address value to return 681 | lret equ aret ;low(aret) 682 | 683 | ;***************************************************************** 684 | ;***************************************************************** 685 | ;** ** 686 | ;** B a s i c D i s k O p e r a t i n g S y s t e m ** 687 | ;** ** 688 | ;***************************************************************** 689 | ;***************************************************************** 690 | 691 | dvers equ 22h ;version 2.2 692 | ; module addresses 693 | 694 | ; literal constants 695 | _true equ 0ffh ;constant true 696 | _false equ 000h ;constant false 697 | enddir equ 0ffffh ;end of directory 698 | byte equ 1 ;number of bytes for "byte" type 699 | word equ 2 ;number of bytes for "word" type 700 | 701 | ; fixed addresses in low memory 702 | tfcb equ 005ch ;default fcb location 703 | tbuff equ 0080h ;default buffer location 704 | 705 | ; fixed addresses referenced in bios module are 706 | ; pererr (0009), selerr (000c), roderr (000f) 707 | 708 | ; error message handlers 709 | 710 | ;per_error: 711 | ;report permanent error to user 712 | ; lxi h,pererr jmp goerr 713 | 714 | ;rod_error: 715 | ;report read/only disk error 716 | ; lxi h,roderr jmp goerr 717 | 718 | ;rof_error: 719 | ;report read/only file error 720 | ; lxi h,roferr ;jmp goerr 721 | 722 | sel_error: 723 | ;report select error 724 | lxi h,selerr 725 | 726 | 727 | goerr: 728 | ;HL = .errorhandler, call subroutine 729 | mov e,m ;address of routine in DE 730 | inx h 731 | mov d,m 732 | xchg ;to subroutine 733 | pchl 734 | 735 | 736 | 737 | ; local subroutines for bios interface 738 | 739 | move: 740 | ;move data length of length C from source DE to 741 | ;destination given by HL 742 | inr c ;in case it is zero 743 | move0: 744 | dcr c ;more to move 745 | rz 746 | ldax d ;one byte moved 747 | mov m,a 748 | inx d ;to next byte 749 | inx h 750 | jmp move0 751 | 752 | selectdisk: 753 | ;select the disk drive given by curdsk, and fill 754 | ;the base addresses curtrka - alloca, then fill 755 | ;the values of the disk parameter block 756 | lda curdsk ;current disk# to c 757 | mov c,a 758 | ;lsb of e = 0 if not yet logged - in 759 | call seldskf ;HL filled by call 760 | ;HL = 0000 if error, otherwise disk headers 761 | mov a,h ;return with 0000 in HL and z flag 762 | ora l 763 | rz 764 | ;disk header block address in hl 765 | mov e,m ;DE=.tran 766 | inx h 767 | mov d,m 768 | inx h 769 | shld cdrmaxa ;.cdrmax 770 | inx h 771 | inx h 772 | shld curtrka ;HL=.currec 773 | inx h 774 | inx h 775 | shld curreca ;HL=.buffa 776 | inx h 777 | inx h 778 | ;DE still contains .tran 779 | xchg ;.tran vector 780 | shld tranv 781 | lxi h,buffa ;DE= source for move, HL=dest 782 | mvi c,addlist ;addlist filled 783 | call move 784 | ;now fill the disk parameter block 785 | lhld dpbaddr ;DE is source 786 | xchg 787 | lxi h,sectpt ;HL is destination 788 | mvi c,dpblist ;data filled 789 | call move 790 | ;now set single/double map mode 791 | lhld maxall ;largest allocation number 792 | mov a,h ;00 indicates < 255 793 | lxi h,single ;assume a=00 794 | mvi m,_true 795 | ora a 796 | jz retselect 797 | ;high order of maxall not zero, use double dm 798 | mvi m,_false 799 | retselect: 800 | mvi a,_true ;select disk function ok 801 | ora a 802 | ret 803 | 804 | home: 805 | ;move to home position, then offset to start of dir 806 | call homef ;move to track 00, sector 00 reference 807 | ;lxi h,offset ;mov c,m ;inx h ;mov b,m ;call settrkf 808 | ;first directory position selected 809 | xra a ;constant zero to accumulator 810 | lhld curtrka ;curtrk=0000 811 | mov m,a 812 | inx h 813 | mov m,a 814 | lhld curreca ;currec=0000 815 | mov m,a 816 | inx h 817 | mov m,a 818 | ;curtrk, currec both set to 0000 819 | ret 820 | 821 | rdbuff: 822 | ;read buffer and check condition 823 | call readf ;current drive, track, sector, dma 824 | jmp diocomp ;check for i/o errors 825 | 826 | wrbuff: 827 | ;write buffer and check condition 828 | ;write type (wrtype) is in register C 829 | ;wrtype = 0 => normal write operation 830 | ;wrtype = 1 => directory write operation 831 | ;wrtype = 2 => start of new block 832 | call writef ;current drive, track, sector, dma 833 | diocomp: ;check for disk errors 834 | ora a 835 | rz 836 | lxi h,pererr 837 | jmp goerr 838 | 839 | seek_dir: 840 | ;seek the record containing the current dir entry 841 | lhld dcnt ;directory counter to HL 842 | mvi c,dskshf ;value to HL 843 | call hlrotr 844 | shld arecord ;ready for seek 845 | shld drec 846 | ; jmp seek 847 | ;ret 848 | 849 | 850 | seek: 851 | ;seek the track given by arecord (actual record) 852 | ;local equates for registers 853 | ;arech equ b ;arecord = BC 854 | ;arecl equ c 855 | ;crech equ d ;currec = DE 856 | ;crecl equ e 857 | ;ctrkh equ h ;curtrk = HL 858 | ;ctrkl equ l 859 | ;tcrech equ h ;tcurrec = HL 860 | ;tcrecl equ l 861 | ;load the registers from memory 862 | lxi h,arecord 863 | mov c,m ; % c = arecl 864 | inx h 865 | mov b,m ; % b = arech 866 | lhld curreca 867 | mov e,m ; % e = crecl 868 | inx h 869 | mov d,m ; % d = crech 870 | lhld curtrka 871 | mov a,m 872 | inx h 873 | mov h,m ; % h = ctrkh 874 | mov l,a ; % l = ctrkl 875 | ;loop while arecord < currec 876 | seek0: 877 | mov a,c ; % c = arecl 878 | sub e ; % e = crecl 879 | mov a,b ; % b = arech 880 | sbb d ; % d = crech 881 | jnc seek1 ;skip if arecord >= currec 882 | ;currec = currec - sectpt 883 | push h ; % h = ctrkh 884 | lhld sectpt 885 | mov a,e ; % e = crecl 886 | sub l 887 | mov e,a ; % e = crecl 888 | mov a,d ; % d = crech 889 | sbb h 890 | mov d,a ; % d = crech 891 | pop h ; % h = ctrkh 892 | ;curtrk = curtrk - 1 893 | dcx h ; % h = ctrkh 894 | jmp seek0 ;for another try 895 | seek1: 896 | ;look while arecord >= (t:=currec + sectpt) 897 | push h ; % h = ctrkh 898 | lhld sectpt ;HL = currec+sectpt 899 | dad d ; % d = crech 900 | jc seek2 ;can be > FFFFH 901 | mov a,c ; % c = arecl 902 | sub l ; % l = tcrecl 903 | mov a,b ; % b = arech 904 | sbb h ; % h = tcrech 905 | jc seek2 ;skip if t > arecord 906 | ;currec = t 907 | xchg 908 | ;curtrk = curtrk + 1 909 | pop h ; % h = ctrkh 910 | inx h ; % h = ctrkh 911 | jmp seek1 ;for another try 912 | seek2: pop h ; % h = ctrkh 913 | ;arrive here with updated values in each register 914 | push b ;to stack for later ; % b = arech 915 | push d ; % d = crech 916 | push h ; % h = ctrkh 917 | ;stack contains (lowest) BC=arecord, DE=currec, HL=curtrk 918 | xchg ;HL = curtrk+offset 919 | lhld offset 920 | dad d 921 | mov b,h ;track set up 922 | mov c,l 923 | call settrkf 924 | ;note that BC - curtrk is difference to move in bios 925 | pop d ;recall curtrk 926 | lhld curtrka ;curtrk updated 927 | mov m,e 928 | inx h 929 | mov m,d 930 | ;now compute sector as arecord-currec 931 | pop d ;recall currec ; % d = crech 932 | lhld curreca 933 | mov m,e ; % e = crecl 934 | inx h 935 | mov m,d ; % d = crech 936 | pop b ;BC=arecord, DE=currec ; % b = arech 937 | mov a,c ; % c = arecl 938 | sub e ; % e = crecl 939 | mov c,a ; % c = arecl 940 | mov a,b ; % b = arech 941 | sbb d ; % d = crech 942 | mov b,a ; % b = arech 943 | lhld tranv ;BC=sector#, DE=.tran 944 | xchg 945 | call sectran ;HL = tran(sector) 946 | mov c,l ;BC = tran(sector) 947 | mov b,h 948 | jmp setsecf ;sector selected 949 | ;ret 950 | 951 | ; file control block (fcb) constants 952 | empty equ 0e5h ;empty directory entry 953 | lstrec equ 127 ;last record# in extent 954 | recsiz equ 128 ;record size 955 | fcblen equ 32 ;file control block size 956 | dirrec equ recsiz/fcblen ;directory elts / record 957 | dskshf equ 2 ;log2(dirrec) 958 | dskmsk equ dirrec-1 959 | fcbshf equ 5 ;log2(fcblen) 960 | 961 | extnum equ 12 ;extent number field 962 | maxext equ 31 ;largest extent number 963 | ubytes equ 13 ;unfilled bytes field 964 | modnum equ 14 ;data module number 965 | maxmod equ 15 ;largest module number 966 | fwfmsk equ 80h ;file write flag is high order modnum 967 | namlen equ 15 ;name length 968 | reccnt equ 15 ;record count field 969 | dskmap equ 16 ;disk map field 970 | lstfcb equ fcblen-1 971 | nxtrec equ fcblen 972 | ranrec equ nxtrec+1;random record field (2 bytes) 973 | 974 | ; reserved file indicators 975 | rofile equ 9 ;high order of first type char 976 | invis equ 10 ;invisible file in dir command 977 | ; equ 11 ;reserved 978 | 979 | ; utility functions for file access 980 | 981 | dm_position: 982 | ;compute disk map position for vrecord to HL 983 | lxi h,blkshf ;shift count to C 984 | mov c,m 985 | lda vrecord ;current virtual record to A 986 | dmpos0: 987 | ora a 988 | rar 989 | dcr c 990 | jnz dmpos0 991 | ;A = shr(vrecord,blkshf) = vrecord/2**(sect/block) 992 | mov b,a ;save it for later addition 993 | mvi a,8 ;8-blkshf to accumulator 994 | sub m 995 | mov c,a ;extent shift count in register c 996 | lda extval ;extent value ani extmsk 997 | dmpos1: 998 | ;blkshf = 3,4,5,6,7, C=5,4,3,2,1 999 | ;shift is 4,3,2,1,0 1000 | dcr c 1001 | jz dmpos2 1002 | ora a 1003 | ral 1004 | jmp dmpos1 1005 | dmpos2: 1006 | ;arrive here with A = shl(ext and extmsk,7-blkshf) 1007 | add b ;add the previous shr(vrecord,blkshf) value 1008 | ;A is one of the following values, depending upon alloc 1009 | ;bks blkshf 1010 | ;1k 3 v/8 + extval * 16 1011 | ;2k 4 v/16+ extval * 8 1012 | ;4k 5 v/32+ extval * 4 1013 | ;8k 6 v/64+ extval * 2 1014 | ;16k 7 v/128+extval * 1 1015 | ret ;with dm_position in A 1016 | 1017 | getdm: 1018 | ;return disk map value from position given by BC 1019 | lhld info ;base address of file control block 1020 | lxi d,dskmap ;HL =.diskmap 1021 | dad d 1022 | dad b ;index by a single byte value 1023 | lda single ;single byte/map entry? 1024 | ora a ;get disk map single byte 1025 | jz getdmd 1026 | mov l,m ;with HL=00bb 1027 | mvi h,0 1028 | ret 1029 | getdmd: 1030 | dad b ;HL=.fcb(dm+i*2) 1031 | ;double precision value returned 1032 | mov e,m 1033 | inx h 1034 | mov d,m 1035 | xchg 1036 | ret 1037 | 1038 | index: 1039 | ;compute disk block number from current fcb 1040 | call dm_position ;0...15 in register A 1041 | mov c,a ;value to HL 1042 | mvi b,0 1043 | call getdm 1044 | shld arecord 1045 | ret 1046 | 1047 | allocated: 1048 | ;called following index to see if block allocated 1049 | lhld arecord 1050 | mov a,l 1051 | ora h 1052 | ret 1053 | 1054 | atran: 1055 | ;compute actual record address, assuming index called 1056 | lda blkshf ;shift count to reg A 1057 | lhld arecord 1058 | atran0: 1059 | dad h ;shl(arecord,blkshf) 1060 | dcr a 1061 | jnz atran0 1062 | shld arecord1 ;save shifted block # 1063 | lda blkmsk ;mask value to C 1064 | mov c,a 1065 | lda vrecord ;masked value in A 1066 | ana c 1067 | ora l ;to HL 1068 | mov l,a 1069 | shld arecord ;arecord=HL or (vrecord and blkmsk) 1070 | ret 1071 | 1072 | getexta: 1073 | ;get current extent field address to A 1074 | lhld info ;HL=.fcb(extnum) 1075 | lxi d,extnum 1076 | dad d 1077 | ret 1078 | 1079 | getfcba: 1080 | ;compute reccnt and nxtrec addresses for get/setfcb 1081 | lhld info ;DE=.fcb(reccnt) 1082 | lxi d,reccnt 1083 | dad d 1084 | xchg 1085 | lxi h,(nxtrec-reccnt) ;HL=.fcb(nxtrec) 1086 | dad d 1087 | ret 1088 | 1089 | getfcb: 1090 | ;set variables from currently addressed fcb 1091 | call getfcba ;addresses in DE, HL 1092 | mov a,m ;vrecord=fcb(nxtrec) 1093 | sta vrecord 1094 | xchg ;rcount=fcb(reccnt) 1095 | mov a,m 1096 | sta rcount 1097 | call getexta ;HL=.fcb(extnum) 1098 | lda extmsk ;extent mask to a 1099 | ana m ;fcb(extnum) and extmsk 1100 | sta extval 1101 | ret 1102 | 1103 | setfcb: 1104 | ;place values back into current fcb 1105 | call getfcba ;addresses to DE, HL 1106 | lda seqio 1107 | cpi 02 ;check ranfill 1108 | jnz setfcb1 1109 | xra a 1110 | setfcb1: 1111 | mov c,a ;=1 if sequential i/o 1112 | lda vrecord ;fcb(nxtrec)=vrecord+seqio 1113 | add c 1114 | mov m,a 1115 | xchg ;fcb(reccnt)=rcount 1116 | lda rcount 1117 | mov m,a 1118 | ret 1119 | 1120 | hlrotr: 1121 | ;hl rotate right by amount C 1122 | inr c ;in case zero 1123 | hlrotr0: 1124 | dcr c ;return when zero 1125 | rz 1126 | mov a,h ;high byte 1127 | ora a 1128 | rar 1129 | mov h,a 1130 | mov a,l ;low byte 1131 | rar 1132 | mov l,a 1133 | jmp hlrotr0 1134 | 1135 | 1136 | compute_cs: 1137 | ;compute checksum for current directory buffer 1138 | mvi c,recsiz ;size of directory buffer 1139 | lhld buffa ;current directory buffer 1140 | xra a ;clear checksum value 1141 | computecs0: 1142 | add m ;cs=cs+buff(recsiz-C) 1143 | inx h 1144 | dcr c 1145 | jnz computecs0 1146 | ret ;with checksum in A 1147 | 1148 | hlrotl: 1149 | ;rotate the mask in HL by amount in C 1150 | inr c ;may be zero 1151 | hlrotl0: 1152 | dcr c ;return if zero 1153 | rz 1154 | dad h 1155 | jmp hlrotl0 1156 | 1157 | set_cdisk: 1158 | ;set a "1" value in curdsk position of BC 1159 | push b ;save input parameter 1160 | lda curdsk ;ready parameter for shift 1161 | mov c,a 1162 | lxi h,1 ;number to shift 1163 | call hlrotl ;HL = mask to integrate 1164 | pop b ;original mask 1165 | mov a,c 1166 | ora l 1167 | mov l,a 1168 | mov a,b ;HL = mask or rol(1,curdsk) 1169 | ora h 1170 | mov h,a 1171 | ret 1172 | 1173 | nowrite: 1174 | ;return true if dir checksum difference occurred 1175 | lhld rodsk 1176 | lda curdsk 1177 | mov c,a 1178 | call hlrotr 1179 | mov a,l ;non zero if nowrite 1180 | ani 1b 1181 | ret 1182 | 1183 | set_ro: 1184 | ;set current disk to read only 1185 | lxi h,rodsk 1186 | mov c,m 1187 | inx h 1188 | mov b,m 1189 | call set_cdisk ;sets bit to 1 1190 | shld rodsk 1191 | ;high water mark in directory goes to max 1192 | lhld dirmax ;DE = directory max 1193 | inx h 1194 | xchg 1195 | lhld cdrmaxa ;HL = .cdrmax 1196 | mov m,e ;cdrmax = dirmax 1197 | inx h 1198 | mov m,d 1199 | ret 1200 | 1201 | check_rodir: 1202 | ;check current directory element for read/only status 1203 | call getdptra ;address of element 1204 | 1205 | check_rofile: 1206 | ;check current buff(dptr) or fcb(0) for r/o status 1207 | lxi d,rofile ;offset to ro bit 1208 | dad d 1209 | mov a,m ;return if not set 1210 | ral 1211 | rnc 1212 | lxi h,roferr 1213 | jmp goerr 1214 | ; jmp rof_error ;exit to read only disk message 1215 | 1216 | 1217 | check_write: 1218 | ;check for write protected disk 1219 | call nowrite ;ok to write if not rodsk 1220 | rz 1221 | lxi h,roderr 1222 | jmp goerr 1223 | ; jmp rod_error ;read only disk error 1224 | 1225 | getdptra: 1226 | ;compute the address of a directory element at 1227 | ;positon dptr in the buffer 1228 | lhld buffa 1229 | lda dptr 1230 | addh: 1231 | ;HL = HL + A 1232 | add l 1233 | mov l,a 1234 | rnc 1235 | ;overflow to H 1236 | inr h 1237 | ret 1238 | 1239 | 1240 | getmodnum: 1241 | ;compute the address of the module number 1242 | ;bring module number to accumulator 1243 | ;(high order bit is fwf (file write flag) 1244 | lhld info ;HL=.fcb(modnum) 1245 | lxi d,modnum 1246 | dad d 1247 | mov a,m ;A=fcb(modnum) 1248 | ret 1249 | 1250 | clrmodnum: 1251 | ;clear the module number field for user open/make 1252 | call getmodnum ;fcb(modnum)=0 1253 | mvi m,0 1254 | ret 1255 | 1256 | setfwf: 1257 | call getmodnum ;HL=.fcb(modnum), A=fcb(modnum) 1258 | ;set fwf (file write flag) to "1" 1259 | ori fwfmsk ;fcb(modnum)=fcb(modnum) or 80h 1260 | mov m,a 1261 | ;also returns non zero in accumulator 1262 | ret 1263 | 1264 | 1265 | compcdr: 1266 | ;return cy if cdrmax > dcnt 1267 | lhld dcnt ;DE = directory counter 1268 | xchg 1269 | lhld cdrmaxa ;HL=.cdrmax 1270 | mov a,e ;low(dcnt) - low(cdrmax) 1271 | sub m 1272 | inx h ;HL = .cdrmax+1 1273 | mov a,d ;hig(dcnt) - hig(cdrmax) 1274 | sbb m 1275 | ;condition dcnt - cdrmax produces cy if cdrmax>dcnt 1276 | ret 1277 | 1278 | setcdr: 1279 | ;if not (cdrmax > dcnt) then cdrmax = dcnt+1 1280 | call compcdr 1281 | rc ;return if cdrmax > dcnt 1282 | ;otherwise, HL = .cdrmax+1, DE = dcnt 1283 | inx d 1284 | mov m,d 1285 | dcx h 1286 | mov m,e 1287 | ret 1288 | 1289 | subdh: 1290 | ;compute HL = DE - HL 1291 | mov a,e 1292 | sub l 1293 | mov l,a 1294 | mov a,d 1295 | sbb h 1296 | mov h,a 1297 | ret 1298 | 1299 | newchecksum: 1300 | mvi c,_true ;drop through to compute new checksum 1301 | checksum: 1302 | ;compute current checksum record and update the 1303 | ;directory element if C=true, or check for = if not 1304 | ;drec < chksiz? 1305 | lhld drec ;DE-HL 1306 | xchg 1307 | lhld chksiz 1308 | call subdh 1309 | rnc ;skip checksum if past checksum vector size 1310 | ;drec < chksiz, so continue 1311 | push b ;save init flag 1312 | call compute_cs ;check sum value to A 1313 | lhld checka ;address of check sum vector 1314 | xchg 1315 | lhld drec ;value of drec 1316 | dad d ;HL = .check(drec) 1317 | pop b ;recall true=0ffh or false=00 to C 1318 | inr c ;0ffh produces zero flag 1319 | jz initial_cs 1320 | ;not initializing, compare 1321 | cmp m ;compute_cs=check(drec)? 1322 | rz ;no message if ok 1323 | ;checksum error, are we beyond 1324 | ;the end of the disk? 1325 | call compcdr 1326 | rnc ;no message if so 1327 | call set_ro ;read/only disk set 1328 | ret 1329 | initial_cs: 1330 | ;initializing the checksum 1331 | mov m,a 1332 | ret 1333 | 1334 | 1335 | wrdir: 1336 | ;write the current directory entry, set checksum 1337 | call newchecksum ;initialize entry 1338 | call setdir ;directory dma 1339 | mvi c,1 ;indicates a write directory operation 1340 | call wrbuff ;write the buffer 1341 | jmp setdata ;to data dma address 1342 | ;ret 1343 | 1344 | rd_dir: 1345 | ;read a directory entry into the directory buffer 1346 | call setdir ;directory dma 1347 | call rdbuff ;directory record loaded 1348 | ; jmp setdata to data dma address 1349 | ;ret 1350 | 1351 | setdata: 1352 | ;set data dma address 1353 | lxi h,dmaad ;to complete the call 1354 | jmp setdma 1355 | 1356 | setdir: 1357 | ;set directory dma address 1358 | lxi h,buffa ;jmp setdma to complete call 1359 | 1360 | setdma: 1361 | ;HL=.dma address to set (i.e., buffa or dmaad) 1362 | mov c,m ;parameter ready 1363 | inx h 1364 | mov b,m 1365 | jmp setdmaf 1366 | 1367 | 1368 | dir_to_user: 1369 | ;copy the directory entry to the user buffer 1370 | ;after call to search or searchn by user code 1371 | lhld buffa ;source is directory buffer 1372 | xchg 1373 | lhld dmaad ;destination is user dma address 1374 | mvi c,recsiz ;copy entire record 1375 | jmp move 1376 | ;ret 1377 | 1378 | end_of_dir: 1379 | ;return zero flag if at end of directory, non zero 1380 | ;if not at end (end of dir if dcnt = 0ffffh) 1381 | lxi h,dcnt ;may be 0ffh 1382 | mov a,m 1383 | inx h ;low(dcnt) = high(dcnt)? 1384 | cmp m 1385 | rnz ;non zero returned if different 1386 | ;high and low the same, = 0ffh? 1387 | inr a ;0ffh becomes 00 if so 1388 | ret 1389 | 1390 | set_end_dir: 1391 | ;set dcnt to the end of the directory 1392 | lxi h,enddir 1393 | shld dcnt 1394 | ret 1395 | 1396 | read_dir: 1397 | ;read next directory entry, with C=true if initializing 1398 | lhld dirmax ;in preparation for subtract 1399 | xchg 1400 | lhld dcnt ;dcnt=dcnt+1 1401 | inx h 1402 | shld dcnt 1403 | ;continue while dirmax >= dcnt (dirmax-dcnt no cy) 1404 | call subdh ;DE-HL 1405 | jnc read_dir0 1406 | ;yes, set dcnt to end of directory 1407 | jmp set_end_dir 1408 | ; ret 1409 | read_dir0: 1410 | ;not at end of directory, seek next element 1411 | ;initialization flag is in C 1412 | lda dcnt ;low(dcnt) and dskmsk 1413 | ani dskmsk 1414 | mvi b,fcbshf ;to multiply by fcb size 1415 | read_dir1: 1416 | add a 1417 | dcr b 1418 | jnz read_dir1 1419 | ;A = (low(dcnt) and dskmsk) shl fcbshf 1420 | sta dptr ;ready for next dir operation 1421 | ora a ;return if not a new record 1422 | rnz 1423 | push b ;save initialization flag C 1424 | call seek_dir ;seek proper record 1425 | call rd_dir ;read the directory record 1426 | pop b ;recall initialization flag 1427 | jmp checksum ;checksum the directory elt 1428 | ;ret 1429 | 1430 | 1431 | getallocbit: 1432 | ;given allocation vector position BC, return with byte 1433 | ;containing BC shifted so that the least significant 1434 | ;bit is in the low order accumulator position. HL is 1435 | ;the address of the byte for possible replacement in 1436 | ;memory upon return, and D contains the number of shifts 1437 | ;required to place the returned value back into position 1438 | mov a,c 1439 | ani 111b 1440 | inr a 1441 | mov e,a 1442 | mov d,a 1443 | ;d and e both contain the number of bit positions to shift 1444 | mov a,c ;C shr 3 to C 1445 | rrc 1446 | rrc 1447 | rrc 1448 | ani 11111b 1449 | mov c,a 1450 | mov a,b ;B shl 5 1451 | add a 1452 | add a 1453 | add a 1454 | add a 1455 | add a 1456 | ora c ;bbbccccc to C 1457 | mov c,a 1458 | mov a,b ;BC shr 3 to BC 1459 | rrc 1460 | rrc 1461 | rrc 1462 | ani 11111b 1463 | mov b,a 1464 | lhld alloca ;base address of allocation vector 1465 | dad b ;byte to A, hl = .alloc(BC shr 3) 1466 | mov a,m 1467 | ;now move the bit to the low order position of A 1468 | rotl: rlc 1469 | dcr e 1470 | jnz rotl 1471 | ret 1472 | 1473 | 1474 | set_alloc_bit: 1475 | ;BC is the bit position of ALLOC to set or reset. The 1476 | ;value of the bit is in register E. 1477 | push d ;shifted val A, count in D 1478 | call getallocbit 1479 | ani 11111110b ;mask low bit to zero (may be set) 1480 | pop b ;low bit of C is masked into A 1481 | ora c 1482 | ; jmp rotr ;to rotate back into proper position 1483 | ;ret 1484 | rotr: 1485 | ;byte value from ALLOC is in register A, with shift count 1486 | ;in register C (to place bit back into position), and 1487 | ;target ALLOC position in registers HL, rotate and replace 1488 | rrc ;back into position 1489 | dcr d 1490 | jnz rotr 1491 | mov m,a ;back to ALLOC 1492 | ret 1493 | 1494 | scandm: 1495 | ;scan the disk map addressed by dptr for non-zero 1496 | ;entries, the allocation vector entry corresponding 1497 | ;to a non-zero entry is set to the value of C (0,1) 1498 | call getdptra ;HL = buffa + dptr 1499 | ;HL addresses the beginning of the directory entry 1500 | lxi d,dskmap ;hl now addresses the disk map 1501 | dad d 1502 | push b ;save the 0/1 bit to set 1503 | mvi c,fcblen-dskmap+1 ;size of single byte disk map + 1 1504 | scandm0: 1505 | ;loop once for each disk map entry 1506 | pop d ;recall bit parity 1507 | dcr c ;all done scanning? 1508 | rz 1509 | ;no, get next entry for scan 1510 | push d ;replace bit parity 1511 | lda single 1512 | ora a 1513 | jz scandm1 1514 | ;single byte scan operation 1515 | push b ;save counter 1516 | push h ;save map address 1517 | mov c,m ;BC=block# 1518 | mvi b,0 1519 | jmp scandm2 1520 | scandm1: 1521 | ;double byte scan operation 1522 | dcr c ;count for double byte 1523 | push b ;save counter 1524 | mov c,m ;BC=block# 1525 | inx h 1526 | mov b,m 1527 | push h ;save map address 1528 | scandm2: 1529 | ;arrive here with BC=block#, E=0/1 1530 | mov a,c ;skip if = 0000 1531 | ora b 1532 | jz scanm3 1533 | lhld maxall ;check invalid index 1534 | mov a,l ;maxall - block# 1535 | sub c 1536 | mov a,h 1537 | sbb b 1538 | cnc set_alloc_bit 1539 | ;bit set to 0/1 1540 | scanm3: 1541 | pop h ;to next bit position 1542 | inx h 1543 | pop b ;recall counter 1544 | jmp scandm0 ;for another item 1545 | 1546 | initialize: 1547 | ;initialize the current disk 1548 | ;lret = false ;set to true if $ file exists 1549 | ;compute the length of the allocation vector - 2 1550 | lhld maxall ;perform maxall/8 1551 | mvi c,3 1552 | ;number of bytes in alloc vector is (maxall/8)+1 1553 | call hlrotr ;HL = maxall/8+1 1554 | inx h 1555 | mov b,h ;count down BC til zero 1556 | mov c,l 1557 | lhld alloca ;base of allocation vector 1558 | ;fill the allocation vector with zeros 1559 | initial0: 1560 | mvi m,0 ;alloc(i)=0 1561 | inx h 1562 | dcx b ;count length down 1563 | mov a,b 1564 | ora c 1565 | jnz initial0 1566 | ;set the reserved space for the directory 1567 | lhld dirblk 1568 | xchg 1569 | lhld alloca ;HL=.alloc() 1570 | mov m,e ;sets reserved directory blks 1571 | inx h 1572 | mov m,d 1573 | ;allocation vector initialized, home disk 1574 | call home 1575 | ;cdrmax = 3 (scans at least one directory record) 1576 | lhld cdrmaxa 1577 | mvi m,3 1578 | inx h 1579 | mvi m,0 1580 | ;cdrmax = 0000 1581 | call set_end_dir ;dcnt = enddir 1582 | ;read directory entries and check for allocated storage 1583 | initial2: 1584 | mvi c,_true 1585 | call read_dir 1586 | call end_of_dir ;return if end of directory 1587 | rz 1588 | ;not end of directory, valid entry? 1589 | call getdptra ;HL = buffa + dptr 1590 | mvi a,empty 1591 | cmp m 1592 | jz initial2 ;go get another item 1593 | ;not empty, user code the same? 1594 | lda usrcode 1595 | cmp m 1596 | jnz pdollar 1597 | ;same user code, check for '$' submit 1598 | inx h ;first character 1599 | mov a,m 1600 | sui '$' ;dollar file? 1601 | jnz pdollar 1602 | ;dollar file found, mark in lret 1603 | dcr a ;lret = 255 1604 | sta lret 1605 | pdollar: 1606 | ;now scan the disk map for allocated blocks 1607 | mvi c,1 ;set to allocated 1608 | call scandm 1609 | call setcdr ;set cdrmax to dcnt 1610 | jmp initial2 ;for another entry 1611 | 1612 | copy_dirloc: 1613 | ;copy directory location to lret following 1614 | ;delete, rename, ... ops 1615 | lda dirloc 1616 | jmp sta_ret 1617 | ; ret 1618 | 1619 | compext: 1620 | ;compare extent# in A with that in C, return nonzero 1621 | ;if they do not match 1622 | push b ;save C's original value 1623 | push psw 1624 | lda extmsk 1625 | cma 1626 | mov b,a 1627 | ;B has negated form of extent mask 1628 | mov a,c ;low bits removed from C 1629 | ana b 1630 | mov c,a 1631 | pop psw ;low bits removed from A 1632 | ana b 1633 | sub c ;set flags 1634 | ani maxext 1635 | pop b ;restore original values 1636 | ret 1637 | 1638 | search: 1639 | ;search for directory element of length C at info 1640 | mvi a,0ffh ;changed if actually found 1641 | sta dirloc 1642 | lxi h,searchl ;searchl = C 1643 | mov m,c 1644 | lhld info ;searcha = info 1645 | shld searcha 1646 | call set_end_dir ;dcnt = enddir 1647 | call home ;to start at the beginning 1648 | ;(drop through to searchn) 1649 | 1650 | searchn: 1651 | ;search for the next directory element, assuming 1652 | ;a previous call on search which sets searcha and 1653 | ;searchl 1654 | mvi c,_false ;read next dir element 1655 | call read_dir 1656 | call end_of_dir ;skip to end if so 1657 | jz search_fin 1658 | ;not end of directory, scan for match 1659 | lhld searcha ;DE=beginning of user fcb 1660 | xchg 1661 | ldax d ;first character 1662 | cpi empty ;keep scanning if empty 1663 | jz searchnext 1664 | ;not empty, may be end of logical directory 1665 | push d ;save search address 1666 | call compcdr ;past logical end? 1667 | pop d ;recall address 1668 | jnc search_fin ;artificial stop 1669 | searchnext: 1670 | call getdptra ;HL = buffa+dptr 1671 | lda searchl ;length of search to c 1672 | mov c,a 1673 | mvi b,0 ;b counts up, c counts down 1674 | searchloop: 1675 | mov a,c 1676 | ora a 1677 | jz endsearch 1678 | ldax d ;? matches all 1679 | cpi '?' 1680 | jz searchok 1681 | ;scan next character if not ubytes 1682 | mov a,b 1683 | cpi ubytes 1684 | jz searchok 1685 | ;not the ubytes field, extent field? 1686 | cpi extnum ;may be extent field 1687 | ldax d ;fcb character 1688 | jz searchext ;skip to search extent 1689 | sub m ;mask-out flags/extent modulus 1690 | ani 7fh 1691 | jnz searchn ;skip if not matched 1692 | jmp searchok ;matched character 1693 | searchext: 1694 | ;A has fcb character 1695 | ;attempt an extent # match 1696 | push b ;save counters 1697 | mov c,m ;directory character to c 1698 | call compext ;compare user/dir char 1699 | pop b ;recall counters 1700 | jnz searchn ;skip if no match 1701 | searchok: 1702 | ;current character matches 1703 | inx d 1704 | inx h 1705 | inr b 1706 | dcr c 1707 | jmp searchloop 1708 | endsearch: 1709 | ;entire name matches, return dir position 1710 | lda dcnt 1711 | ani dskmsk 1712 | sta lret 1713 | ;lret = low(dcnt) and 11b 1714 | lxi h,dirloc ;dirloc=0ffh? 1715 | mov a,m 1716 | ral 1717 | rnc 1718 | ;yes, change it to 0 to mark as found 1719 | xra a ;dirloc=0 1720 | mov m,a 1721 | ret 1722 | search_fin: 1723 | ;end of directory, or empty name 1724 | call set_end_dir ;may be artifical end 1725 | mvi a,255 1726 | jmp sta_ret 1727 | 1728 | 1729 | delete: 1730 | ;delete the currently addressed file 1731 | call check_write ;write protected? 1732 | mvi c,extnum ;search through file type 1733 | call search 1734 | delete0: 1735 | ;loop while directory matches 1736 | call end_of_dir ;stop if end 1737 | rz 1738 | ;set each non zero disk map entry to 0 1739 | ;in the allocation vector 1740 | ;may be r/o file 1741 | call check_rodir ;ro disk error if found 1742 | call getdptra ;HL=.buff(dptr) 1743 | mvi m,empty 1744 | mvi c,0 ;alloc elts set to 0 1745 | call scandm 1746 | call wrdir ;write the directory 1747 | call searchn ;to next element 1748 | jmp delete0 ;for another record 1749 | 1750 | get_block: 1751 | ;given allocation vector position BC, find the zero bit 1752 | ;closest to this position by searching left and right. 1753 | ;if found, set the bit to one and return the bit position 1754 | ;in hl. if not found (i.e., we pass 0 on the left, or 1755 | ;maxall on the right), return 0000 in hl 1756 | mov d,b ;copy of starting position to de 1757 | mov e,c 1758 | lefttst: 1759 | mov a,c ;skip if left=0000 1760 | ora b 1761 | jz righttst 1762 | ;left not at position zero, bit zero? 1763 | dcx b ;left,right pushed 1764 | push d 1765 | push b 1766 | call getallocbit 1767 | rar ;return block number if zero 1768 | jnc retblock 1769 | ;bit is one, so try the right 1770 | pop b ;left, right restored 1771 | pop d 1772 | righttst: 1773 | lhld maxall ;value of maximum allocation# 1774 | mov a,e ;right=maxall? 1775 | sub l 1776 | mov a,d 1777 | sbb h 1778 | jnc retblock0 ;return block 0000 if so 1779 | inx d ;left, right pushed 1780 | push b 1781 | push d 1782 | mov b,d ;ready right for call 1783 | mov c,e 1784 | call getallocbit 1785 | rar ;return block number if zero 1786 | jnc retblock 1787 | pop d ;restore left and right pointers 1788 | pop b 1789 | jmp lefttst ;for another attempt 1790 | retblock: 1791 | ral ;bit back into position and set to 1 1792 | inr a 1793 | ;d contains the number of shifts required to reposition 1794 | call rotr ;move bit back to position and store 1795 | pop h ;HL returned value, DE discarded 1796 | pop d 1797 | ret 1798 | retblock0: 1799 | ;cannot find an available bit, return 0000 1800 | mov a,c ; 1801 | ora b ;also at beginning 1802 | jnz lefttst 1803 | lxi h,0000h 1804 | ret 1805 | 1806 | copy_fcb: 1807 | ;copy the entire file control block 1808 | mvi c,0 ;start at 0, to fcblen-1 1809 | mvi e,fcblen 1810 | ; jmp copy_dir 1811 | 1812 | copy_dir: 1813 | ;copy fcb information starting at C for E bytes 1814 | ;into the currently addressed directory entry 1815 | push d ;save length for later 1816 | mvi b,0 ;double index to BC 1817 | lhld info ;HL = source for data 1818 | dad b ;DE=.fcb(C), source for copy 1819 | xchg 1820 | call getdptra ;HL=.buff(dptr), destination 1821 | pop b ;DE=source, HL=dest, C=length 1822 | call move ;data moved 1823 | seek_copy: 1824 | ;enter from close to seek and copy current element 1825 | call seek_dir ;to the directory element 1826 | jmp wrdir ;write the directory element 1827 | ;ret 1828 | 1829 | 1830 | rename: 1831 | ;rename the file described by the first half of 1832 | ;the currently addressed file control block. the 1833 | ;new name is contained in the last half of the 1834 | ;currently addressed file conrol block. the file 1835 | ;name and type are changed, but the reel number 1836 | ;is ignored. the user number is identical 1837 | call check_write ;may be write protected 1838 | ;search up to the extent field 1839 | mvi c,extnum 1840 | call search 1841 | ;copy position 0 1842 | lhld info ;HL=.fcb(0), A=fcb(0) 1843 | mov a,m 1844 | lxi d,dskmap ;HL=.fcb(dskmap) 1845 | dad d 1846 | mov m,a ;fcb(dskmap)=fcb(0) 1847 | ;assume the same disk drive for new named file 1848 | rename0: 1849 | call end_of_dir ;stop at end of dir 1850 | rz 1851 | ;not end of directory, rename next element 1852 | call check_rodir ;may be read-only file 1853 | mvi c,dskmap 1854 | mvi e,extnum 1855 | call copy_dir 1856 | ;element renamed, move to next 1857 | call searchn 1858 | jmp rename0 1859 | 1860 | indicators: 1861 | ;set file indicators for current fcb 1862 | mvi c,extnum ;through file type 1863 | call search 1864 | indic0: 1865 | call end_of_dir ;stop at end of dir 1866 | rz 1867 | ;not end of directory, continue to change 1868 | mvi c,0 ;copy name 1869 | mvi e,extnum 1870 | call copy_dir 1871 | call searchn 1872 | jmp indic0 1873 | 1874 | open: 1875 | ;search for the directory entry, copy to fcb 1876 | mvi c,namlen 1877 | call search 1878 | call end_of_dir ;return with lret=255 if end 1879 | rz 1880 | ;not end of directory, copy fcb information 1881 | open_copy: 1882 | ;(referenced below to copy fcb info) 1883 | call getexta ;save extent# 1884 | mov a,m 1885 | push psw 1886 | push h 1887 | call getdptra ;DE = .buff(dptr) 1888 | xchg 1889 | lhld info ;HL=.fcb(0) 1890 | mvi c,nxtrec ;length of move operation 1891 | push d ;save .buff(dptr) 1892 | call move ;from .buff(dptr) to .fcb(0) 1893 | ;note that entire fcb is copied, including indicators 1894 | call setfwf ;sets file write flag 1895 | pop d ;HL=.buff(dptr+extnum) 1896 | lxi h,extnum 1897 | dad d 1898 | mov c,m ;C = directory extent number 1899 | lxi h,reccnt ;HL=.buff(dptr+reccnt) 1900 | dad d 1901 | mov b,m ;B holds directory record count 1902 | pop h ;restore extent number 1903 | pop psw 1904 | mov m,a 1905 | ;HL = .user extent#, B = dir rec cnt, C = dir extent# 1906 | ;if user ext < dir ext then user := 128 records 1907 | ;if user ext = dir ext then user := dir records 1908 | ;if user ext > dir ext then user := 0 records 1909 | mov a,c ;ready dir reccnt 1910 | cmp m 1911 | mov a,b 1912 | jz open_rcnt ;if same, user gets dir reccnt 1913 | mvi a,0 ;user is larger 1914 | jc open_rcnt 1915 | mvi a,128 ;directory is larger 1916 | open_rcnt: ;A has record count to fill 1917 | lhld info 1918 | lxi d,reccnt 1919 | dad d 1920 | mov m,a 1921 | ret 1922 | 1923 | mergezero: 1924 | ;HL = .fcb1(i), DE = .fcb2(i), 1925 | ;if fcb1(i) = 0 then fcb1(i) := fcb2(i) 1926 | mov a,m ;return if = 0000 1927 | inx h 1928 | ora m 1929 | dcx h 1930 | rnz 1931 | ldax d ;low byte copied 1932 | mov m,a 1933 | inx d 1934 | inx h 1935 | ldax d ;back to input form 1936 | mov m,a 1937 | dcx d 1938 | dcx h 1939 | ret 1940 | 1941 | close: 1942 | ;locate the directory element and re-write it 1943 | xra a 1944 | sta lret 1945 | sta dcnt 1946 | sta dcnt+1 1947 | call nowrite ;skip close if r/o disk 1948 | rnz 1949 | ;check file write flag - 0 indicates written 1950 | call getmodnum ;fcb(modnum) in A 1951 | ani fwfmsk ;return if bit remains set 1952 | rnz 1953 | mvi c,namlen ;locate file 1954 | call search 1955 | call end_of_dir ;return if not found 1956 | rz 1957 | ;merge the disk map at info with that at buff(dptr) 1958 | lxi b,dskmap 1959 | call getdptra 1960 | dad b ;DE is .buff(dptr+16) 1961 | xchg 1962 | lhld info ;DE=.buff(dptr+16), HL=.fcb(16) 1963 | dad b 1964 | mvi c,(fcblen-dskmap) ;length of single byte dm 1965 | merge0: 1966 | lda single ;skip to double 1967 | ora a 1968 | jz merged 1969 | ;this is a single byte map 1970 | ;if fcb(i) = 0 then fcb(i) = buff(i) 1971 | ;if buff(i) = 0 then buff(i) = fcb(i) 1972 | ;if fcb(i) <> buff(i) then error 1973 | mov a,m 1974 | ora a 1975 | ldax d 1976 | jnz fcbnzero 1977 | ;fcb(i) = 0 1978 | mov m,a ;fcb(i) = buff(i) 1979 | fcbnzero: 1980 | ora a 1981 | jnz buffnzero 1982 | ;buff(i) = 0 1983 | mov a,m ;buff(i)=fcb(i) 1984 | stax d 1985 | buffnzero: 1986 | cmp m ;fcb(i) = buff(i)? 1987 | jnz mergerr 1988 | jmp dmset ;if merge ok 1989 | merged: 1990 | ;this is a double byte merge operation 1991 | call mergezero ;buff = fcb if buff 0000 1992 | xchg ;fcb = buff if fcb 0000 1993 | call mergezero 1994 | xchg 1995 | ;they should be identical at this point 1996 | ldax d ;low same? 1997 | cmp m 1998 | jnz mergerr 1999 | inx d ;to high byte 2000 | inx h 2001 | ldax d ;high same? 2002 | cmp m 2003 | jnz mergerr 2004 | ;merge operation ok for this pair 2005 | dcr c ;extra count for double byte 2006 | dmset: 2007 | inx d ;to next byte position 2008 | inx h 2009 | dcr c ;for more 2010 | jnz merge0 2011 | ;end of disk map merge, check record count 2012 | ;DE = .buff(dptr)+32, HL = .fcb(32) 2013 | lxi b,-(fcblen-extnum) 2014 | dad b 2015 | xchg 2016 | dad b 2017 | ;DE = .fcb(extnum), HL = .buff(dptr+extnum) 2018 | ldax d ;current user extent number 2019 | ;if fcb(ext) >= buff(fcb) then 2020 | ;buff(ext) := fcb(ext), buff(rec) := fcb(rec) 2021 | cmp m 2022 | jc endmerge 2023 | ;fcb extent number >= dir extent number 2024 | mov m,a ;buff(ext) = fcb(ext) 2025 | ;update directory record count field 2026 | lxi b,(reccnt-extnum) 2027 | dad b 2028 | xchg 2029 | dad b 2030 | ;DE=.buff(reccnt), HL=.fcb(reccnt) 2031 | mov a,m ;buff(reccnt)=fcb(reccnt) 2032 | stax d 2033 | endmerge: 2034 | mvi a,_true ;mark as copied 2035 | sta fcb_copied 2036 | jmp seek_copy ;ok to "wrdir" here - 1.4 compat 2037 | ; ret 2038 | mergerr: 2039 | ;elements did not merge correctly 2040 | lxi h,lret ;=255 non zero flag set 2041 | dcr m 2042 | ret 2043 | 2044 | make: 2045 | ;create a new file by creating a directory entry 2046 | ;then opening the file 2047 | call check_write ;may be write protected 2048 | lhld info ;save fcb address, look for e5 2049 | push h 2050 | lxi h,efcb ;info = .empty 2051 | shld info 2052 | mvi c,1 ;length 1 match on empty entry 2053 | call search 2054 | call end_of_dir ;zero flag set if no space 2055 | pop h ;recall info address 2056 | shld info ;in case we return here 2057 | rz ;return with error condition 255 if not found 2058 | xchg ;DE = info address 2059 | ;clear the remainder of the fcb 2060 | lxi h,namlen ;HL=.fcb(namlen) 2061 | dad d 2062 | mvi c,fcblen-namlen ;number of bytes to fill 2063 | xra a ;clear accumulator to 00 for fill 2064 | make0: 2065 | mov m,a 2066 | inx h 2067 | dcr c 2068 | jnz make0 2069 | lxi h,ubytes ;HL = .fcb(ubytes) 2070 | dad d 2071 | mov m,a ;fcb(ubytes) = 0 2072 | call setcdr ;may have extended the directory 2073 | ;now copy entry to the directory 2074 | call copy_fcb 2075 | ;and set the file write flag to "1" 2076 | jmp setfwf 2077 | ;ret 2078 | 2079 | open_reel: 2080 | ;close the current extent, and open the next one 2081 | ;if possible. RMF is true if in read mode 2082 | xra a ;set true if actually copied 2083 | sta fcb_copied 2084 | call close ;close current extent 2085 | ;lret remains at enddir if we cannot open the next ext 2086 | call end_of_dir ;return if end 2087 | rz 2088 | ;increment extent number 2089 | lhld info ;HL=.fcb(extnum) 2090 | lxi b,extnum 2091 | dad b 2092 | mov a,m ;fcb(extnum)=++1 2093 | inr a 2094 | ani maxext 2095 | mov m,a 2096 | jz open_mod ;move to next module if zero 2097 | ;may be in the same extent group 2098 | mov b,a 2099 | lda extmsk 2100 | ana b 2101 | ;if result is zero, then not in the same group 2102 | lxi h,fcb_copied ;true if the fcb was copied to directory 2103 | ana m ;produces a 00 in accumulator if not written 2104 | jz open_reel0 ;go to next physical extent 2105 | ;result is non zero, so we must be in same logical ext 2106 | jmp open_reel1 ;to copy fcb information 2107 | open_mod: 2108 | ;extent number overflow, go to next module 2109 | lxi b,(modnum-extnum) ;HL=.fcb(modnum) 2110 | dad b 2111 | inr m ;fcb(modnum)=++1 2112 | ;module number incremented, check for overflow 2113 | mov a,m ;mask high order bits 2114 | ani maxmod 2115 | jz open_r_err ;cannot overflow to zero 2116 | ;otherwise, ok to continue with new module 2117 | open_reel0: 2118 | mvi c,namlen ;next extent found? 2119 | call search 2120 | call end_of_dir 2121 | jnz open_reel1 2122 | ;end of file encountered 2123 | lda rmf ;0ffh becomes 00 if read 2124 | inr a 2125 | jz open_r_err ;sets lret = 1 2126 | ;try to extend the current file 2127 | call make 2128 | ;cannot be end of directory 2129 | call end_of_dir 2130 | jz open_r_err ;with lret = 1 2131 | jmp open_reel2 2132 | open_reel1: 2133 | ;not end of file, open 2134 | call open_copy 2135 | open_reel2: 2136 | call getfcb ;set parameters 2137 | xra a ;lret = 0 2138 | jmp sta_ret 2139 | ; ret ;with lret = 0 2140 | open_r_err: 2141 | ;cannot move to next extent of this file 2142 | call setlret1 ;lret = 1 2143 | jmp setfwf ;ensure that it will not be closed 2144 | ;ret 2145 | 2146 | seqdiskread: 2147 | ;sequential disk read operation 2148 | mvi a,1 2149 | sta seqio 2150 | ;drop through to diskread 2151 | 2152 | diskread: ;(may enter from seqdiskread) 2153 | mvi a,_true ;read mode flag = true (open_reel) 2154 | sta rmf 2155 | ;read the next record from the current fcb 2156 | call getfcb ;sets parameters for the read 2157 | lda vrecord ;vrecord-rcount 2158 | lxi h,rcount 2159 | cmp m 2160 | ;skip if rcount > vrecord 2161 | jc recordok 2162 | ;not enough records in the extent 2163 | ;record count must be 128 to continue 2164 | cpi 128 ;vrecord = 128? 2165 | jnz diskeof ;skip if vrecord<>128 2166 | call open_reel ;go to next extent if so 2167 | xra a ;vrecord=00 2168 | sta vrecord 2169 | ;now check for open ok 2170 | lda lret ;stop at eof 2171 | ora a 2172 | jnz diskeof 2173 | recordok: 2174 | ;arrive with fcb addressing a record to read 2175 | call index 2176 | ;error 2 if reading unwritten data 2177 | ;(returns 1 to be compatible with 1.4) 2178 | call allocated ;arecord=0000? 2179 | jz diskeof 2180 | ;record has been allocated, read it 2181 | call atran ;arecord now a disk address 2182 | call seek ;to proper track,sector 2183 | call rdbuff ;to dma address 2184 | jmp setfcb ;replace parameter 2185 | ; ret 2186 | diskeof: 2187 | jmp setlret1 ;lret = 1 2188 | ;ret 2189 | 2190 | seqdiskwrite: 2191 | ;sequential disk write 2192 | mvi a,1 2193 | sta seqio 2194 | ;drop through to diskwrite 2195 | 2196 | diskwrite: ;(may enter here from seqdiskwrite above) 2197 | mvi a,_false ;read mode flag 2198 | sta rmf 2199 | ;write record to currently selected file 2200 | call check_write ;in case write protected 2201 | lhld info ;HL = .fcb(0) 2202 | call check_rofile ;may be a read-only file 2203 | call getfcb ;to set local parameters 2204 | lda vrecord ;vrecord-128 2205 | cpi lstrec+1 2206 | ;skip if vrecord > lstrec 2207 | ;vrecord = 128, cannot open next extent 2208 | jnc setlret1 ;lret=1 2209 | diskwr0: 2210 | ;can write the next record, so continue 2211 | call index 2212 | call allocated 2213 | mvi c,0 ;marked as normal write operation for wrbuff 2214 | jnz diskwr1 2215 | ;not allocated 2216 | ;the argument to getblock is the starting 2217 | ;position for the disk search, and should be 2218 | ;the last allocated block for this file, or 2219 | ;the value 0 if no space has been allocated 2220 | call dm_position 2221 | sta dminx ;save for later 2222 | lxi b,0000h ;may use block zero 2223 | ora a ;skip if no previous block 2224 | jz nopblock 2225 | ;previous block exists at A 2226 | mov c,a ;previous block # in BC 2227 | dcx b 2228 | call getdm ;previous block # to HL 2229 | mov b,h ;BC=prev block# 2230 | mov c,l 2231 | nopblock: 2232 | ;BC = 0000, or previous block # 2233 | call get_block ;block # to HL 2234 | ;arrive here with block# or zero 2235 | mov a,l 2236 | ora h 2237 | jnz blockok 2238 | ;cannot find a block to allocate 2239 | mvi a,2 ;lret=2 2240 | jmp sta_ret 2241 | blockok: 2242 | ;allocated block number is in HL 2243 | shld arecord 2244 | xchg ;block number to DE 2245 | lhld info ;HL=.fcb(dskmap) 2246 | lxi b,dskmap 2247 | dad b 2248 | lda single ;set flags for single byte dm 2249 | ora a 2250 | lda dminx ;recall dm index 2251 | jz allocwd ;skip if allocating word 2252 | ;allocating a byte value 2253 | call addh ;single byte alloc 2254 | mov m,e 2255 | jmp diskwru ;to continue 2256 | allocwd: 2257 | ;allocate a word value 2258 | mov c,a ;double(dminx) 2259 | mvi b,0 2260 | dad b ;HL=.fcb(dminx*2) 2261 | dad b 2262 | mov m,e ;double wd 2263 | inx h 2264 | mov m,d 2265 | diskwru: 2266 | ;disk write to previously unallocated block 2267 | mvi c,2 ;marked as unallocated write 2268 | diskwr1: 2269 | ;continue the write operation of no allocation error 2270 | ;C = 0 if normal write, 2 if to prev unalloc block 2271 | lda lret ;stop if non zero returned value 2272 | ora a 2273 | rnz 2274 | push b ;save write flag 2275 | call atran ;arecord set 2276 | lda seqio 2277 | dcr a 2278 | dcr a 2279 | jnz diskwr11 2280 | pop b 2281 | push b 2282 | mov a,c 2283 | dcr a 2284 | dcr a 2285 | jnz diskwr11 ;old allocation 2286 | push h ;arecord in hl ret from atran 2287 | lhld buffa ;zero buffa & fill 2288 | mov d,a 2289 | fill0: mov m,a 2290 | inx h 2291 | inr d 2292 | jp fill0 2293 | call setdir 2294 | lhld arecord1 2295 | mvi c,2 2296 | fill1: shld arecord 2297 | push b 2298 | call seek 2299 | pop b 2300 | call wrbuff ;write fill record 2301 | lhld arecord ;restore last record 2302 | mvi c,0 ;change allocate flag 2303 | lda blkmsk 2304 | mov b,a 2305 | ana l 2306 | cmp b 2307 | inx h 2308 | jnz fill1 ;cont until cluster is zeroed 2309 | pop h 2310 | shld arecord 2311 | call setdata 2312 | diskwr11: 2313 | call seek ;to proper file position 2314 | pop b ;restore/save write flag (C=2 if new block) 2315 | push b 2316 | call wrbuff ;written to disk 2317 | pop b ;C = 2 if a new block was allocated, 0 if not 2318 | ;increment record count if rcount<=vrecord 2319 | lda vrecord ;vrecord-rcount 2320 | lxi h,rcount 2321 | cmp m 2322 | jc diskwr2 2323 | ;rcount <= vrecord 2324 | mov m,a ;rcount = vrecord+1 2325 | inr m 2326 | mvi c,2 ;mark as record count incremented 2327 | diskwr2: 2328 | if patch1 2329 | ; CP/M V2.2 patch 1 for use of optional blocking/deblocking 2330 | nop 2331 | nop 2332 | lxi h,0 2333 | else 2334 | ; original code 2335 | ;A has vrecord, C=2 if new block or new record# 2336 | dcr c 2337 | dcr c 2338 | jnz noupdate 2339 | endif 2340 | push psw ;save vrecord value 2341 | call getmodnum ;HL=.fcb(modnum), A=fcb(modnum) 2342 | ;reset the file write flag to mark as written fcb 2343 | ani (~fwfmsk)&0ffh ;bit reset 2344 | mov m,a ;fcb(modnum) = fcb(modnum) and 7fh 2345 | pop psw ;restore vrecord 2346 | noupdate: 2347 | ;check for end of extent, if found attempt to open 2348 | ;next extent in preparation for next write 2349 | cpi lstrec ;vrecord=lstrec? 2350 | jnz diskwr3 ;skip if not 2351 | ;may be random access write, if so we are done 2352 | ;change next 2353 | lda seqio ;skip next extent open op 2354 | cpi 1 2355 | jnz diskwr3 2356 | ;update current fcb before going to next extent 2357 | call setfcb 2358 | call open_reel ;rmf=false 2359 | ;vrecord remains at lstrec causing eof if 2360 | ;no more directory space is available 2361 | lxi h,lret 2362 | mov a,m 2363 | ora a 2364 | jnz nospace 2365 | ;space available, set vrecord=255 2366 | dcr a ;goes to 00 next time 2367 | sta vrecord 2368 | nospace: 2369 | mvi m,0 ;lret = 00 for returned value 2370 | diskwr3: 2371 | jmp setfcb ;replace parameters 2372 | ;ret 2373 | 2374 | rseek: 2375 | ;random access seek operation, C=0ffh if read mode 2376 | ;fcb is assumed to address an active file control block 2377 | ;(modnum has been set to 1100_0000b if previous bad seek) 2378 | xra a ;marked as random access operation 2379 | sta seqio 2380 | rseek1: 2381 | push b ;save r/w flag 2382 | lhld info ;DE will hold base of fcb 2383 | xchg 2384 | lxi h,ranrec ;HL=.fcb(ranrec) 2385 | dad d 2386 | mov a,m ;record number 2387 | ani 7fh 2388 | push psw 2389 | mov a,m ;cy=lsb of extent# 2390 | ral 2391 | inx h ;A=ext# 2392 | mov a,m 2393 | ral 2394 | ani 11111b 2395 | mov c,a ;C holds extent number, record stacked 2396 | mov a,m ;mod# 2397 | rar 2398 | rar 2399 | rar 2400 | rar 2401 | ani 1111b 2402 | mov b,a ;B holds module#, C holds ext# 2403 | pop psw ;recall sought record # 2404 | ;check to insure that high byte of ran rec = 00 2405 | inx h ;l=high byte (must be 00) 2406 | mov l,m 2407 | inr l ;zero flag, l=6 2408 | dcr l 2409 | mvi l,6 2410 | ;produce error 6, seek past physical eod 2411 | jnz seekerr 2412 | ;otherwise, high byte = 0, A = sought record 2413 | lxi h,nxtrec ;HL = .fcb(nxtrec) 2414 | dad d 2415 | mov m,a ;sought rec# stored away 2416 | ;arrive here with B=mod#, C=ext#, DE=.fcb, rec stored 2417 | ;the r/w flag is still stacked. compare fcb values 2418 | lxi h,extnum ;A=seek ext# 2419 | dad d 2420 | mov a,c 2421 | sub m ;tests for = extents 2422 | jnz ranclose 2423 | ;extents match, check mod# 2424 | lxi h,modnum ;B=seek mod# 2425 | dad d 2426 | mov a,b 2427 | ;could be overflow at eof, producing module# 2428 | ;of 90H or 10H, so compare all but fwf 2429 | sub m ;same? 2430 | ani 7fh 2431 | jz seekok 2432 | ranclose: 2433 | push b ;save seek mod#,ext#, .fcb 2434 | push d 2435 | call close ;current extent closed 2436 | pop d ;recall parameters and fill 2437 | pop b 2438 | mvi l,3 ;cannot close error #3 2439 | lda lret 2440 | inr a 2441 | jz badseek 2442 | lxi h,extnum ;fcb(extnum)=ext# 2443 | dad d 2444 | mov m,c 2445 | lxi h,modnum ;fcb(modnum)=mod# 2446 | dad d 2447 | mov m,b 2448 | call open ;is the file present? 2449 | lda lret ;open successful? 2450 | inr a 2451 | jnz seekok 2452 | ;cannot open the file, read mode? 2453 | pop b ;r/w flag to c (=0ffh if read) 2454 | push b ;everyone expects this item stacked 2455 | mvi l,4 ;seek to unwritten extent #4 2456 | inr c ;becomes 00 if read operation 2457 | jz badseek ;skip to error if read operation 2458 | ;write operation, make new extent 2459 | call make 2460 | mvi l,5 ;cannot create new extent #5 2461 | lda lret ;no dir space 2462 | inr a 2463 | jz badseek 2464 | ;file make operation successful 2465 | seekok: 2466 | pop b ;discard r/w flag 2467 | xra a ;with zero set 2468 | jmp sta_ret 2469 | badseek: 2470 | ;fcb no longer contains a valid fcb, mark 2471 | ;with 1100_000b in modnum field so that it 2472 | ;appears as overflow with file write flag set 2473 | push h ;save error flag 2474 | call getmodnum ;HL = .modnum 2475 | mvi m,11000000b 2476 | pop h ;and drop through 2477 | seekerr: 2478 | pop b ;discard r/w flag 2479 | mov a,l ;lret=#, nonzero 2480 | sta lret 2481 | ;setfwf returns non-zero accumulator for err 2482 | jmp setfwf ;flag set, so subsequent close ok 2483 | ;ret 2484 | 2485 | randiskread: 2486 | ;random disk read operation 2487 | mvi c,_true ;marked as read operation 2488 | call rseek 2489 | cz diskread ;if seek successful 2490 | ret 2491 | 2492 | randiskwrite: 2493 | ;random disk write operation 2494 | mvi c,_false ;marked as write operation 2495 | call rseek 2496 | cz diskwrite ;if seek successful 2497 | ret 2498 | 2499 | compute_rr: 2500 | ;compute random record position for getfilesize/setrandom 2501 | xchg 2502 | dad d 2503 | ;DE=.buf(dptr) or .fcb(0), HL = .f(nxtrec/reccnt) 2504 | mov c,m ;BC = 0000 0000 ?rrr rrrr 2505 | mvi b,0 2506 | lxi h,extnum ;A=e000 0000 2507 | dad d 2508 | mov a,m 2509 | rrc 2510 | ani 80h 2511 | add c 2512 | mov c,a 2513 | mvi a,0 2514 | adc b 2515 | mov b,a 2516 | ;BC = 0000 000? errrr rrrr 2517 | mov a,m 2518 | rrc 2519 | ani 0fh 2520 | add b 2521 | mov b,a 2522 | ;BC = 000? eeee errrr rrrr 2523 | lxi h,modnum ;A=XXX? mmmm 2524 | dad d 2525 | mov a,m 2526 | add a ;cy=? A=mmmm 0000 2527 | add a 2528 | add a 2529 | add a 2530 | push psw 2531 | add b 2532 | mov b,a 2533 | ;cy=?, BC = mmmm eeee errr rrrr 2534 | push psw ;possible second carry 2535 | pop h ;cy = lsb of L 2536 | mov a,l ;cy = lsb of A 2537 | pop h ;cy = lsb of L 2538 | ora l ;cy/cy = lsb of A 2539 | ani 1 ;A = 0000 000? possible carry-out 2540 | ret 2541 | 2542 | getfilesize: 2543 | ;compute logical file size for current fcb 2544 | mvi c,extnum 2545 | call search 2546 | ;zero the receiving ranrec field 2547 | lhld info ;save position 2548 | lxi d,ranrec 2549 | dad d 2550 | push h 2551 | mov m,d ;=00 00 00 2552 | inx h 2553 | mov m,d 2554 | inx h 2555 | mov m,d 2556 | getsize: 2557 | call end_of_dir 2558 | jz setsize 2559 | ;current fcb addressed by dptr 2560 | call getdptra ;ready for compute size 2561 | lxi d,reccnt 2562 | call compute_rr 2563 | ;A=0000 000? BC = mmmm eeee errr rrrr 2564 | ;compare with memory, larger? 2565 | pop h ;recall, replace .fcb(ranrec) 2566 | push h 2567 | mov e,a ;save cy 2568 | mov a,c ;ls byte 2569 | sub m 2570 | inx h 2571 | mov a,b ;middle byte 2572 | sbb m 2573 | inx h 2574 | mov a,e ;carry if .fcb(ranrec) > directory 2575 | sbb m 2576 | jc getnextsize ;for another try 2577 | ;fcb is less or equal, fill from directory 2578 | mov m,e 2579 | dcx h 2580 | mov m,b 2581 | dcx h 2582 | mov m,c 2583 | getnextsize: 2584 | call searchn 2585 | jmp getsize 2586 | setsize: 2587 | pop h ;discard .fcb(ranrec) 2588 | ret 2589 | 2590 | setrandom: 2591 | ;set random record from the current file control block 2592 | lhld info ;ready params for computesize 2593 | lxi d,nxtrec 2594 | call compute_rr ;DE=info, A=cy, BC=mmmm eeee errr rrrr 2595 | lxi h,ranrec ;HL = .fcb(ranrec) 2596 | dad d 2597 | mov m,c ;to ranrec 2598 | inx h 2599 | mov m,b 2600 | inx h 2601 | mov m,a 2602 | ret 2603 | 2604 | select: 2605 | ;select disk info for subsequent input or output ops 2606 | lhld dlog 2607 | lda curdsk 2608 | mov c,a 2609 | call hlrotr 2610 | push h ;save it for test below, send to seldsk 2611 | xchg 2612 | call selectdisk ;recall dlog vector 2613 | pop h 2614 | cz sel_error ;returns true if select ok 2615 | ;is the disk logged in? 2616 | mov a,l ;return if bit is set 2617 | rar 2618 | rc 2619 | ;disk not logged in, set bit and initialize 2620 | lhld dlog ;call ready 2621 | mov c,l 2622 | mov b,h 2623 | call set_cdisk ;dlog=set_cdisk(dlog) 2624 | shld dlog 2625 | jmp initialize 2626 | ;ret 2627 | 2628 | curselect: 2629 | lda linfo ;skip if linfo=curdsk 2630 | lxi h,curdsk 2631 | cmp m 2632 | rz 2633 | mov m,a ;curdsk=info 2634 | jmp select 2635 | ;ret 2636 | 2637 | reselect: 2638 | ;check current fcb to see if reselection necessary 2639 | mvi a,_true ;mark possible reselect 2640 | sta resel 2641 | lhld info ;drive select code 2642 | mov a,m 2643 | ani 11111b ;non zero is auto drive select 2644 | dcr a ;drive code normalized to 0..30, or 255 2645 | sta linfo ;save drive code 2646 | cpi 30 2647 | jnc noselect 2648 | ;auto select function, save curdsk 2649 | lda curdsk ;olddsk=curdsk 2650 | sta olddsk 2651 | mov a,m ;save drive code 2652 | sta fcbdsk 2653 | ani 11100000b ;preserve hi bits 2654 | mov m,a 2655 | call curselect 2656 | noselect: 2657 | ;set user code 2658 | lda usrcode ;0...31 2659 | lhld info 2660 | ora m 2661 | mov m,a 2662 | ret 2663 | 2664 | ; individual function handlers 2665 | func12: 2666 | ;return version number 2667 | mvi a,dvers ;lret = dvers (high = 00) 2668 | jmp sta_ret 2669 | ; ret ;jmp goback 2670 | 2671 | func13: 2672 | ;reset disk system - initialize to disk 0 2673 | lxi h,0 2674 | shld rodsk 2675 | shld dlog 2676 | xra a ;note that usrcode remains unchanged 2677 | sta curdsk 2678 | lxi h,tbuff ;dmaad = tbuff 2679 | shld dmaad 2680 | call setdata ;to data dma address 2681 | jmp select 2682 | ;ret ;jmp goback 2683 | 2684 | func14 equ curselect 2685 | ;select disk info 2686 | ;ret ;jmp goback 2687 | 2688 | func15: 2689 | ;open file 2690 | call clrmodnum ;clear the module number 2691 | call reselect 2692 | jmp open 2693 | ;ret ;jmp goback 2694 | 2695 | func16: 2696 | ;close file 2697 | call reselect 2698 | jmp close 2699 | ;ret ;jmp goback 2700 | 2701 | func17: 2702 | ;search for first occurrence of a file 2703 | mvi c,0 ;length assuming '?' true 2704 | xchg ;was lhld info 2705 | mov a,m ;no reselect if ? 2706 | cpi '?' 2707 | jz qselect ;skip reselect if so 2708 | ;normal search 2709 | call getexta 2710 | mov a,m 2711 | cpi '?' 2712 | cnz clrmodnum ;module number zeroed 2713 | call reselect 2714 | mvi c,namlen 2715 | qselect: 2716 | call search 2717 | jmp dir_to_user ;copy directory entry to user 2718 | ;ret ;jmp goback 2719 | 2720 | func18: 2721 | ;search for next occurrence of a file name 2722 | lhld searcha 2723 | shld info 2724 | call reselect 2725 | call searchn 2726 | jmp dir_to_user ;copy directory entry to user 2727 | ;ret ;jmp goback 2728 | 2729 | func19: 2730 | ;delete a file 2731 | call reselect 2732 | call delete 2733 | jmp copy_dirloc 2734 | ;ret ;jmp goback 2735 | 2736 | func20: 2737 | ;read a file 2738 | call reselect 2739 | jmp seqdiskread ; 2740 | ;jmp goback 2741 | 2742 | func21: 2743 | ;write a file 2744 | call reselect 2745 | jmp seqdiskwrite ; 2746 | ;jmp goback 2747 | 2748 | func22: 2749 | ;make a file 2750 | call clrmodnum 2751 | call reselect 2752 | jmp make 2753 | ;ret ;jmp goback 2754 | 2755 | func23: 2756 | ;rename a file 2757 | call reselect 2758 | call rename 2759 | jmp copy_dirloc 2760 | ;ret ;jmp goback 2761 | 2762 | func24: 2763 | ;return the login vector 2764 | lhld dlog 2765 | jmp sthl_ret ; 2766 | ; ret ;jmp goback 2767 | 2768 | func25: 2769 | ;return selected disk number 2770 | lda curdsk 2771 | jmp sta_ret 2772 | ; ret ;jmp goback 2773 | 2774 | func26: 2775 | ;set the subsequent dma address to info 2776 | xchg ;was lhld info 2777 | shld dmaad ;dmaad = info 2778 | jmp setdata ;to data dma address 2779 | ;ret ;jmp goback 2780 | 2781 | func27: 2782 | ;return the login vector address 2783 | lhld alloca 2784 | jmp sthl_ret 2785 | ; ret ;jmp goback 2786 | 2787 | func28 equ set_ro 2788 | ;write protect current disk 2789 | ;ret ;jmp goback 2790 | 2791 | func29: 2792 | ;return r/o bit vector 2793 | lhld rodsk 2794 | jmp sthl_ret 2795 | ; ret ;jmp goback 2796 | 2797 | func30: 2798 | ;set file indicators 2799 | call reselect 2800 | call indicators 2801 | jmp copy_dirloc ;lret=dirloc 2802 | ;ret ;jmp goback 2803 | 2804 | func31: 2805 | ;return address of disk parameter block 2806 | lhld dpbaddr 2807 | sthl_ret: 2808 | shld aret 2809 | ret ;jmp goback 2810 | func32: 2811 | ;set user code 2812 | lda linfo 2813 | cpi 0ffh 2814 | jnz setusrcode 2815 | ;interrogate user code instead 2816 | lda usrcode ;lret=usrcode 2817 | jmp sta_ret 2818 | ; ret ;jmp goback 2819 | setusrcode: 2820 | ani 1fh 2821 | sta usrcode 2822 | ret ;jmp goback 2823 | ; 2824 | func33: 2825 | ;random disk read operation 2826 | call reselect 2827 | jmp randiskread ;to perform the disk read 2828 | ;ret ;jmp goback 2829 | ; 2830 | func34: 2831 | ;random disk write operation 2832 | call reselect 2833 | jmp randiskwrite ;to perform the disk write 2834 | ;ret ;jmp goback 2835 | ; 2836 | func35: 2837 | ;return file size (0-65536) 2838 | call reselect 2839 | jmp getfilesize 2840 | ;ret ;jmp goback 2841 | ; 2842 | func36 equ setrandom ; 2843 | ;set random record 2844 | ;ret ;jmp goback 2845 | func37: 2846 | ; 2847 | lhld info 2848 | mov a,l 2849 | cma 2850 | mov e,a 2851 | mov a,h 2852 | cma 2853 | lhld dlog 2854 | ana h 2855 | mov d,a 2856 | mov a,l 2857 | ana e 2858 | mov e,a 2859 | lhld rodsk 2860 | xchg 2861 | shld dlog 2862 | mov a,l 2863 | ana e 2864 | mov l,a 2865 | mov a,h 2866 | ana d 2867 | mov h,a 2868 | shld rodsk 2869 | ret 2870 | ; 2871 | ; 2872 | goback: 2873 | ;arrive here at end of processing to return to user 2874 | lda resel 2875 | ora a 2876 | jz retmon 2877 | ;reselection may have taken place 2878 | lhld info ;fcb(0)=0 2879 | mvi m,0 2880 | lda fcbdsk 2881 | ora a 2882 | jz retmon 2883 | ;restore disk number 2884 | mov m,a ;fcb(0)=fcbdsk 2885 | lda olddsk 2886 | sta linfo 2887 | call curselect 2888 | ; 2889 | ; return from the disk monitor 2890 | retmon: 2891 | lhld entsp ;user stack restored 2892 | sphl 2893 | lhld aret ;BA = HL = aret 2894 | mov a,l 2895 | mov b,h 2896 | ret 2897 | 2898 | func38 equ func_ret 2899 | func39 equ func_ret 2900 | 2901 | func40: 2902 | ;random disk write with zero fill of unallocated block 2903 | call reselect 2904 | mvi a,2 2905 | sta seqio 2906 | mvi c,_false 2907 | call rseek1 2908 | cz diskwrite ;if seek successful 2909 | ret 2910 | 2911 | 2912 | ; data areas 2913 | 2914 | ; initialized data 2915 | efcb: db empty ;0e5=available dir entry 2916 | rodsk: dw 0 ;read only disk vector 2917 | dlog: dw 0 ;logged-in disks 2918 | dmaad: dw tbuff ;initial dma address 2919 | 2920 | ; curtrka - alloca are set upon disk select 2921 | ; (data must be adjacent, do not insert variables) 2922 | ; (address of translate vector, not used) 2923 | cdrmaxa:ds word ;pointer to cur dir max value 2924 | curtrka:ds word ;current track address 2925 | curreca:ds word ;current record address 2926 | buffa: ds word ;pointer to directory dma address 2927 | dpbaddr:ds word ;current disk parameter block address 2928 | checka: ds word ;current checksum vector address 2929 | alloca: ds word ;current allocation vector address 2930 | addlist equ $-buffa ;address list size 2931 | 2932 | ; sectpt - offset obtained from disk parm block at dpbaddr 2933 | ; (data must be adjacent, do not insert variables) 2934 | sectpt: ds word ;sectors per track 2935 | blkshf: ds byte ;block shift factor 2936 | blkmsk: ds byte ;block mask 2937 | extmsk: ds byte ;extent mask 2938 | maxall: ds word ;maximum allocation number 2939 | dirmax: ds word ;largest directory number 2940 | dirblk: ds word ;reserved allocation bits for directory 2941 | chksiz: ds word ;size of checksum vector 2942 | offset: ds word ;offset tracks at beginning 2943 | dpblist equ $-sectpt ;size of area 2944 | 2945 | ; local variables 2946 | tranv: ds word ;address of translate vector 2947 | fcb_copied: 2948 | ds byte ;set true if copy_fcb called 2949 | rmf: ds byte ;read mode flag for open_reel 2950 | dirloc: ds byte ;directory flag in rename, etc. 2951 | seqio: ds byte ;1 if sequential i/o 2952 | linfo: ds byte ;low(info) 2953 | dminx: ds byte ;local for diskwrite 2954 | searchl:ds byte ;search length 2955 | searcha:ds word ;search address 2956 | tinfo: ds word ;temp for info in "make" 2957 | single: ds byte ;set true if single byte allocation map 2958 | resel: ds byte ;reselection flag 2959 | olddsk: ds byte ;disk on entry to bdos 2960 | fcbdsk: ds byte ;disk named in fcb 2961 | rcount: ds byte ;record count in current fcb 2962 | extval: ds byte ;extent number and extmsk 2963 | vrecord:ds word ;current virtual record 2964 | arecord:ds word ;current actual record 2965 | arecord1: ds word ;current actual block# * blkmsk 2966 | 2967 | ; local variables for directory access 2968 | dptr: ds byte ;directory pointer 0,1,2,3 2969 | dcnt: ds word ;directory counter 0,1,...,dirmax 2970 | drec: ds word ;directory record 0,1,...,dirmax/4 2971 | 2972 | bios equ ($ & 0ff00h)+100h ;next module 2973 | end 2974 | -------------------------------------------------------------------------------- /ccp.asm: -------------------------------------------------------------------------------- 1 | ; Reformatted and converted for cross-assembly by Macro Assembler AS 2 | ; Eric Smith 2018-01-24 3 | ; from original source os2ccp.asm from 4 | ; http://www.cpm.z80.de/download/cpm2-plm.zip 5 | 6 | ; Changes: 7 | ; multiple instructions per line split to separate lines 8 | ; dollar sign in labels replaced by underscore 9 | ; dollar sign (as digit separator) in binary constants removed 10 | ; single quotes around strings replaced with double quotes 11 | ; true and false replaced with _true and _false 12 | ; replaced "not" operator with "~" 13 | ; removed empty comments 14 | ; added ifdef origin to allow origin to be specified from command line 15 | ; added commments about serial number 16 | ; added ifdefs on "noserial" to omit serialization check 17 | 18 | 19 | .cpu 8080 20 | 21 | title "console command processor (CCP), ver 2.0" 22 | ; assembly language version of the CP/M console command processor 23 | 24 | ; version 2.2 February, 1980 25 | 26 | ; Copyright (c) 1976, 1977, 1978, 1979, 1980 27 | ; Digital Research 28 | ; Box 579, Pacific Grove, 29 | ; California, 93950 30 | 31 | _false equ 0000h 32 | _true equ ~_false 33 | testing equ _false ;true if debugging 34 | 35 | 36 | ifdef origin 37 | org origin 38 | bdosl equ $+800h ;bdos location 39 | else 40 | if testing 41 | org 3400h 42 | bdosl equ $+800h ;bdos location 43 | else 44 | org 000h 45 | bdosl equ $+800h ;bdos location 46 | endif 47 | endif 48 | tran equ 100h 49 | tranm equ $ 50 | ccploc equ $ 51 | 52 | ; ******************************************************** 53 | ; * Base of CCP contains the following code/data * 54 | ; * ccp: jmp ccpstart (start with command) * 55 | ; * jmp ccpclear (start, clear command) * 56 | ; * ccp+6 127 (max command length) * 57 | ; * ccp+7 comlen (command length = 00) * 58 | ; * ccp+8 ' ... ' (16 blanks) * 59 | ; ******************************************************** 60 | ; * Normal entry is at ccp, where the command line given * 61 | ; * at ccp+8 is executed automatically (normally a null * 62 | ; * command with comlen = 00). An initializing program * 63 | ; * can be automatically loaded by storing the command * 64 | ; * at ccp+8, with the command length at ccp+7. In this * 65 | ; * case, the ccp executes the command before prompting * 66 | ; * the console for input. Note that the command is exe-* 67 | ; * cuted on both warm and cold starts. When the command* 68 | ; * line is initialized, a jump to "jmp ccpclear" dis- * 69 | ; * ables the automatic command execution. * 70 | ; ******************************************************** 71 | 72 | jmp ccpstart ;start ccp with possible initial command 73 | jmp ccpclear ;clear the command buffer 74 | maxlen: db 127 ;max buffer length 75 | comlen: db 0 ;command length (filled in by dos) 76 | ; (command executed initially if comlen non zero) 77 | combuf: 78 | db " " ;8 character fill 79 | db " " ;8 character fill 80 | db "COPYRIGHT (C) 1979, DIGITAL RESEARCH "; 38 81 | ds 128-($-combuf) 82 | ; total buffer length is 128 characters 83 | comaddr:dw combuf ;address of next to char to scan 84 | staddr: ds 2 ;starting address of current fillfcb request 85 | 86 | diska equ 0004h ;disk address for current disk 87 | bdos equ 0005h ;primary bdos entry point 88 | buff equ 0080h ;default buffer 89 | fcb equ 005ch ;default file control block 90 | 91 | rcharf equ 1 ;read character function 92 | pcharf equ 2 ;print character function 93 | pbuff equ 9 ;print buffer function 94 | rbuff equ 10 ;read buffer function 95 | breakf equ 11 ;break key function 96 | liftf equ 12 ;lift head function (no operation) 97 | initf equ 13 ;initialize bdos function 98 | self equ 14 ;select disk function 99 | openf equ 15 ;open file function 100 | closef equ 16 ;close file function 101 | searf equ 17 ;search for file function 102 | searnf equ 18 ;search for next file function 103 | delf equ 19 ;delete file function 104 | dreadf equ 20 ;disk read function 105 | dwritf equ 21 ;disk write function 106 | makef equ 22 ;file make function 107 | renf equ 23 ;rename file function 108 | logf equ 24 ;return login vector 109 | cself equ 25 ;return currently selected drive number 110 | dmaf equ 26 ;set dma address 111 | userf equ 32 ;set user number 112 | 113 | ; special fcb flags 114 | rofile equ 9 ;read only file 115 | sysfile equ 10 ;system file flag 116 | 117 | ; special characters 118 | cr equ 13 ;carriage return 119 | lf equ 10 ;line feed 120 | la equ 5fh ;left arrow 121 | eofile equ 1ah ;end of file 122 | 123 | ; utility procedures 124 | printchar: 125 | mov e,a 126 | mvi c,pcharf 127 | jmp bdos 128 | 129 | printbc: 130 | ;print character, but save b,c registers 131 | push b 132 | call printchar 133 | pop b 134 | ret 135 | 136 | crlf: 137 | mvi a,cr 138 | call printbc 139 | mvi a,lf 140 | jmp printbc 141 | 142 | blank: 143 | mvi a,' ' 144 | jmp printbc 145 | 146 | print: ;print string starting at b,c until next 00 entry 147 | push b ;now print the string 148 | call crlf 149 | pop h 150 | prin0: mov a,m ;stop on 00 151 | ora a 152 | rz 153 | inx h ;ready for next 154 | push h 155 | call printchar ;character printed 156 | pop h 157 | jmp prin0 ;for another character 158 | 159 | initialize: 160 | mvi c,initf 161 | jmp bdos 162 | 163 | select: 164 | mov e,a 165 | mvi c,self 166 | jmp bdos 167 | 168 | bdos_inr: 169 | call bdos 170 | sta dcnt 171 | inr a 172 | ret 173 | 174 | open: ;open the file given by d,e 175 | mvi c,openf 176 | jmp bdos_inr 177 | 178 | openc: ;open comfcb 179 | xra a ;clear next record to read 180 | sta comrec 181 | lxi d,comfcb 182 | jmp open 183 | 184 | close: ;close the file given by d,e 185 | mvi c,closef 186 | jmp bdos_inr 187 | 188 | search: ;search for the file given by d,e 189 | mvi c,searf 190 | jmp bdos_inr 191 | 192 | searchn: 193 | ;search for the next occurrence of the file given by d,e 194 | mvi c,searnf 195 | jmp bdos_inr 196 | 197 | searchcom: 198 | ;search for comfcb file 199 | lxi d,comfcb 200 | jmp search 201 | 202 | delete: ;delete the file given by d,e 203 | mvi c,delf 204 | jmp bdos 205 | 206 | bdos_cond: 207 | call bdos 208 | ora a 209 | ret 210 | 211 | diskread: 212 | ;read the next record from the file given by d,e 213 | mvi c,dreadf 214 | jmp bdos_cond 215 | 216 | diskreadc: 217 | ;read the comfcb file 218 | lxi d,comfcb 219 | jmp diskread 220 | 221 | diskwrite: 222 | ;write the next record to the file given by d,e 223 | mvi c,dwritf 224 | jmp bdos_cond 225 | 226 | make: ;create the file given by d,e 227 | mvi c,makef 228 | jmp bdos_inr 229 | 230 | renam: ;rename the file given by d,e 231 | mvi c,renf 232 | jmp bdos 233 | 234 | getuser: 235 | ;return current user code in a 236 | mvi e,0ffh ;drop through to setuser 237 | 238 | setuser: 239 | mvi c,userf ;sets user number 240 | jmp bdos 241 | 242 | saveuser: 243 | ;save user#/disk# before possible ^c or transient 244 | call getuser ;code to a 245 | add a ;rot left 246 | add a 247 | add a 248 | add a 249 | lxi h,cdisk ;4b=user, 4b=disk 250 | ora m 251 | sta diska ;stored away in memory for later 252 | ret 253 | 254 | setdiska: 255 | lda cdisk ;user/disk 256 | sta diska 257 | ret 258 | 259 | translate: 260 | ;translate character in register A to upper case 261 | cpi 61h ;return if below lower case a 262 | rc 263 | cpi 7bh ;return if above lower case z 264 | rnc 265 | ani 5fh ;translated to upper case 266 | ret 267 | 268 | readcom: 269 | ;read the next command into the command buffer 270 | ;check for submit file 271 | lda submit 272 | ora a 273 | jz nosub 274 | ;scanning a submit file 275 | ;change drives to open and read the file 276 | lda cdisk 277 | ora a 278 | mvi a,0 279 | cnz select 280 | ;have to open again in case xsub present 281 | lxi d,subfcb ;skip if no sub 282 | call open 283 | jz nosub 284 | lda subrc ;read last record(s) first 285 | dcr a 286 | sta subcr ;current record to read 287 | lxi d,subfcb ;end of file if last record 288 | call diskread 289 | jnz nosub 290 | ;disk read is ok, transfer to combuf 291 | lxi d,comlen 292 | lxi h,buff 293 | mvi b,128 294 | call move0 295 | ;line is transferred, close the file with a 296 | ;deleted record 297 | lxi h,submod ;clear fwflag 298 | mvi m,0 299 | inx h ;one less record 300 | dcr m 301 | lxi d,subfcb 302 | call close 303 | jz nosub 304 | ;close went ok, return to original drive 305 | lda cdisk 306 | ora a 307 | cnz select 308 | ;print to the 00 309 | lxi h,combuf 310 | call prin0 311 | call break_key 312 | jz noread 313 | call del_sub ;break key depressed 314 | jmp ccp 315 | 316 | nosub: ;no submit file 317 | call del_sub 318 | ;translate to upper case, store zero at end 319 | call saveuser ;user # save in case control c 320 | mvi c,rbuff 321 | lxi d,maxlen 322 | call bdos 323 | call setdiska ;no control c, so restore diska 324 | noread: ;enter here from submit file 325 | ;set the last character to zero for later scans 326 | lxi h,comlen ;length is in b 327 | mov b,m 328 | readcom0: 329 | inx h ;end of scan? 330 | mov a,b 331 | ora a 332 | jz readcom1 ;get character and translate 333 | mov a,m 334 | call translate 335 | mov m,a 336 | dcr b 337 | jmp readcom0 338 | 339 | readcom1: ;end of scan, h,l address end of command 340 | mov m,a ;store a zero 341 | lxi h,combuf ;ready to scan to zero 342 | shld comaddr 343 | ret 344 | 345 | break_key: 346 | ;check for a character ready at the console 347 | mvi c,breakf 348 | call bdos 349 | ora a 350 | rz 351 | mvi c,rcharf ;character cleared 352 | call bdos 353 | ora a 354 | ret 355 | 356 | cselect: 357 | ;get the currently selected drive number to reg-A 358 | mvi c,cself 359 | jmp bdos 360 | 361 | setdmabuff: 362 | ;set default buffer dma address 363 | lxi d,buff ;(drop through) 364 | 365 | setdma: 366 | ;set dma address to d,e 367 | mvi c,dmaf 368 | jmp bdos 369 | 370 | del_sub: 371 | ;delete the submit file, and set submit flag to false 372 | lxi h,submit ;return if no sub file 373 | mov a,m 374 | ora a 375 | rz 376 | mvi m,0 ;submit flag is set to false 377 | xra a ;on drive a to erase file 378 | call select 379 | lxi d,subfcb 380 | call delete 381 | lda cdisk ;back to original drive 382 | jmp select 383 | 384 | ifndef noserial 385 | serialize: 386 | ;check serialization 387 | lxi d,serial ;check six bytes 388 | lxi h,bdosl 389 | mvi b,6 390 | ser0: ldax d 391 | cmp m 392 | jnz badserial 393 | inx d 394 | inx h 395 | dcr b 396 | jnz ser0 397 | ret ;serial number is ok 398 | endif 399 | 400 | comerr: 401 | ;error in command string starting at position 402 | ;'staddr' and ending with first delimiter 403 | call crlf ;space to next line 404 | lhld staddr ;h,l address first to print 405 | comerr0: ;print characters until blank or zero 406 | mov a,m ; not blank 407 | cpi ' ' 408 | jz comerr1 409 | ora a ; not zero, so print it 410 | jz comerr1 411 | push h 412 | call printchar 413 | pop h 414 | inx h 415 | jmp comerr0; for another character 416 | comerr1: ;print question mark,and delete sub file 417 | mvi a,'?' 418 | call printchar 419 | call crlf 420 | call del_sub 421 | jmp ccp ;restart with next command 422 | 423 | ; fcb scan and fill subroutine (entry is at fillfcb below) 424 | ;fill the comfcb, indexed by A (0 or 16) 425 | ;subroutines 426 | delim: ;look for a delimiter 427 | ldax d ;not the last element 428 | ora a 429 | rz 430 | cpi ' ' ;non graphic 431 | jc comerr 432 | rz ;treat blank as delimiter 433 | cpi '=' 434 | rz 435 | cpi la ;left arrow 436 | rz 437 | cpi '.' 438 | rz 439 | cpi ':' 440 | rz 441 | cpi ';' 442 | rz 443 | cpi '<' 444 | rz 445 | cpi '>' 446 | rz 447 | ret ;delimiter not found 448 | 449 | deblank: ;deblank the input line 450 | ldax d ;treat end of line as blank 451 | ora a 452 | rz 453 | cpi ' ' 454 | rnz 455 | inx d 456 | jmp deblank 457 | 458 | addh: ;add a to h,l 459 | add l 460 | mov l,a 461 | rnc 462 | inr h 463 | ret 464 | 465 | fillfcb0: 466 | ;equivalent to fillfcb(0) 467 | mvi a,0 468 | 469 | fillfcb: 470 | lxi h,comfcb ;fcb rescanned at end 471 | call addh 472 | push h 473 | push h 474 | xra a ;clear selected disk (in case A:...) 475 | sta sdisk 476 | lhld comaddr ;command address in d,e 477 | xchg 478 | call deblank ;to first non-blank character 479 | xchg ;in case of errors 480 | shld staddr 481 | xchg ;d,e has command, h,l has fcb address 482 | pop h 483 | ;look for preceding file name A: B: ... 484 | ldax d ;use current disk if empty command 485 | ora a 486 | jz setcur0 487 | sbi 'A'-1 ;disk name held in b if : follows 488 | mov b,a 489 | inx d ;set disk name if : 490 | ldax d 491 | cpi ':' 492 | jz setdsk 493 | 494 | setcur: ;set current disk 495 | dcx d ;back to first character of command 496 | setcur0: 497 | lda cdisk 498 | mov m,a 499 | jmp setname 500 | 501 | setdsk: ;set disk to name in register b 502 | mov a,b ;mark as disk selected 503 | sta sdisk 504 | mov m,b ;past the : 505 | inx d 506 | 507 | setname: ;set the file name field 508 | mvi b,8 ;file name length (max) 509 | setnam0: 510 | call delim ;not a delimiter 511 | jz padname 512 | inx h ;must be ?'s 513 | cpi '*' 514 | jnz setnam1 515 | mvi m,'?' ;to dec count 516 | jmp setnam2 517 | 518 | setnam1: 519 | mov m,a ;store character to fcb 520 | inx d 521 | setnam2: 522 | dcr b ;count down length 523 | jnz setnam0 524 | 525 | ;end of name, truncate remainder 526 | trname: call delim ;set type field if delimiter 527 | jz setty 528 | inx d 529 | jmp trname 530 | 531 | padname: 532 | inx h 533 | mvi m,' ' 534 | dcr b 535 | jnz padname 536 | 537 | setty: ;set the type field 538 | mvi b,3 ;skip the type field if no . 539 | cpi '.' 540 | jnz padty 541 | inx d ;past the ., to the file type field 542 | setty0: ;set the field from the command buffer 543 | call delim 544 | jz padty 545 | inx h 546 | cpi '*' 547 | jnz setty1 548 | mvi m,'?' ;since * specified 549 | jmp setty2 550 | 551 | setty1: ;not a *, so copy to type field 552 | mov m,a 553 | inx d 554 | setty2: ;decrement count and go again 555 | dcr b 556 | jnz setty0 557 | 558 | ;end of type field, truncate 559 | trtyp: ;truncate type field 560 | call delim 561 | jz efill 562 | inx d 563 | jmp trtyp 564 | 565 | padty: ;pad the type field with blanks 566 | inx h 567 | mvi m,' ' 568 | dcr b 569 | jnz padty 570 | 571 | efill: ;end of the filename/filetype fill, save command address 572 | ;fill the remaining fields for the fcb 573 | mvi b,3 574 | efill0: inx h 575 | mvi m,0 576 | dcr b 577 | jnz efill0 578 | xchg ;set new starting point 579 | shld comaddr 580 | 581 | ;recover the start address of the fcb and count ?'s 582 | pop h ;b=0, c=8+3 583 | lxi b,11 584 | scnq: inx h 585 | mov a,m 586 | cpi '?' 587 | jnz scnq0 588 | ;? found, count it in b 589 | inr b 590 | scnq0: dcr c 591 | jnz scnq 592 | 593 | ;number of ?'s in c, move to a and return with flags set 594 | mov a,b 595 | ora a 596 | ret 597 | 598 | intvec: 599 | ;intrinsic function names (all are four characters) 600 | db "DIR " 601 | db "ERA " 602 | db "TYPE" 603 | db "SAVE" 604 | db "REN " 605 | db "USER" 606 | intlen equ ($-intvec)/4 ;intrinsic function length 607 | 608 | ; serial number (details not documented in original DRI source file) 609 | serial: db 0 ; OEM number, low byte 610 | db 0 ; CP/M version, 16h = 2.2 611 | db 0 ; OEM number, high byte 612 | db 0,0,0 ; serial number, big-endian 613 | 614 | 615 | intrinsic: 616 | ;look for intrinsic functions (comfcb has been filled) 617 | lxi h,intvec ;c counts intrinsics as scanned 618 | mvi c,0 619 | intrin0: 620 | mov a,c ;done with scan? 621 | cpi intlen 622 | rnc 623 | ;no, more to scan 624 | lxi d,comfcb+1 ;beginning of name 625 | mvi b,4 ;length of match is in b 626 | intrin1: 627 | ldax d ;match? 628 | cmp m 629 | jnz intrin2 ;skip if no match 630 | inx d 631 | inx h 632 | dcr b 633 | jnz intrin1 ;loop while matching 634 | 635 | ;complete match on name, check for blank in fcb 636 | ldax d ;otherwise matched 637 | cpi ' ' 638 | jnz intrin3 639 | mov a,c ;with intrinsic number in a 640 | ret 641 | 642 | intrin2: ;mismatch, move to end of intrinsic 643 | inx h 644 | dcr b 645 | jnz intrin2 646 | 647 | intrin3: ;try next intrinsic 648 | inr c ;to next intrinsic number 649 | jmp intrin0 ;for another round 650 | 651 | ccpclear: 652 | ;clear the command buffer 653 | xra a 654 | sta comlen 655 | ;drop through to start ccp 656 | ccpstart: 657 | ;enter here from boot loader 658 | lxi sp,stack ;save initial disk number 659 | push b 660 | ;(high order 4bits=user code, low 4bits=disk#) 661 | mov a,c ;user code 662 | rar 663 | rar 664 | rar 665 | rar 666 | ani 0fh 667 | 668 | mov e,a ;user code selected 669 | call setuser 670 | ;initialize for this user, get $ flag 671 | call initialize ;0ffh in accum if $ file present 672 | sta submit ;submit flag set if $ file present 673 | pop b ;recall user code and disk number 674 | mov a,c ;disk number in accumulator 675 | ani 0fh 676 | sta cdisk ;clears user code nibble 677 | call select ;proper disk is selected, now check sub files 678 | ;check for initial command 679 | lda comlen ;assume typed already 680 | ora a 681 | jnz ccp0 682 | 683 | ccp: 684 | ;enter here on each command or error condition 685 | lxi sp,stack 686 | call crlf ;print d> prompt, where d is disk name 687 | call cselect ;get current disk number 688 | adi 'A' 689 | call printchar 690 | mvi a,'>' 691 | call printchar 692 | call readcom ;command buffer filled 693 | ccp0: ;(enter here from initialization with command full) 694 | lxi d,buff ;default dma address at buff 695 | call setdma 696 | call cselect ;current disk number saved 697 | sta cdisk 698 | call fillfcb0 ;command fcb filled 699 | cnz comerr ;the name cannot be an ambiguous reference 700 | lda sdisk 701 | ora a 702 | jnz userfunc 703 | ;check for an intrinsic function 704 | call intrinsic 705 | lxi h,jmptab ;index is in the accumulator 706 | mov e,a ;index in d,e 707 | mvi d,0 708 | dad d 709 | dad d 710 | mov a,m 711 | inx h 712 | mov h,m 713 | mov l,a 714 | pchl 715 | ;pc changes to the proper intrinsic or user function 716 | 717 | jmptab: 718 | dw direct ;directory search 719 | dw erase ;file erase 720 | dw type ;type file 721 | dw save ;save memory image 722 | dw rename ;file rename 723 | dw user ;user number 724 | dw userfunc;user-defined function 725 | 726 | ifndef noserial 727 | badserial: 728 | LXI H,76F3H ;'DI HLT' instructions. 729 | ;typo "lxi h,di or (hlt shl 8)" here originally, 730 | ;corrected by comparing to disassembly of Clark Calkins. 731 | shld ccploc 732 | lxi h,ccploc 733 | pchl 734 | endif 735 | 736 | ;utility subroutines for intrinsic handlers 737 | readerr: 738 | ;print the read error message 739 | lxi b,rdmsg 740 | jmp print 741 | rdmsg: db "READ ERROR",0 742 | 743 | nofile: 744 | ;print no file message 745 | lxi b,nofmsg 746 | jmp print 747 | nofmsg: db "NO FILE",0 748 | 749 | getnumber: ;read a number from the command line 750 | call fillfcb0 ;should be number 751 | lda sdisk ;cannot be prefixed 752 | ora a 753 | jnz comerr 754 | ;convert the byte value in comfcb to binary 755 | lxi h,comfcb+1 ;(b=0, c=11) 756 | lxi b,11 757 | ;value accumulated in b, c counts name length to zero 758 | conv0: mov a,m 759 | cpi ' ' 760 | jz conv1 761 | ;more to scan, convert char to binary and add 762 | inx h ;valid? 763 | sui '0' 764 | cpi 10 765 | jnc comerr 766 | mov d,a ;save value 767 | mov a,b ;mult by 10 768 | ani 11100000b 769 | jnz comerr 770 | mov a,b ;recover value 771 | rlc ;*8 772 | rlc 773 | rlc 774 | add b 775 | jc comerr 776 | add b ;*8+*2 = *10 777 | jc comerr 778 | add d ;+digit 779 | jc comerr 780 | mov b,a ;for another digit 781 | dcr c 782 | jnz conv0 783 | ret 784 | conv1: ;end of digits, check for all blanks 785 | mov a,m ;blanks? 786 | cpi ' ' 787 | jnz comerr 788 | inx h 789 | dcr c 790 | jnz conv1 791 | mov a,b ;recover value 792 | ret 793 | 794 | movename: 795 | ;move 3 characters from h,l to d,e addresses 796 | mvi b,3 797 | move0: mov a,m 798 | stax d 799 | inx h 800 | inx d 801 | dcr b 802 | jnz move0 803 | ret 804 | 805 | addhcf: ;buff + a + c to h,l followed by fetch 806 | lxi h,buff 807 | add c 808 | call addh 809 | mov a,m 810 | ret 811 | 812 | setdisk: 813 | ;change disks for this command, if requested 814 | xra a ;clear disk name from fcb 815 | sta comfcb 816 | lda sdisk ;no action if not specified 817 | ora a 818 | rz 819 | dcr a ;already selected 820 | lxi h,cdisk 821 | cmp m 822 | rz 823 | jmp select 824 | 825 | resetdisk: 826 | ;return to original disk after command 827 | lda sdisk ;no action if not selected 828 | ora a 829 | rz 830 | dcr a ;same disk 831 | lxi h,cdisk 832 | cmp m 833 | rz 834 | lda cdisk 835 | jmp select 836 | 837 | ;individual intrinsics follow 838 | direct: 839 | ;directory search 840 | call fillfcb0 ;comfcb gets file name 841 | call setdisk ;change disk drives if requested 842 | lxi h,comfcb+1 ;may be empty request 843 | mov a,m 844 | cpi ' ' ;skip fill of ??? if not blank 845 | jnz dir1 846 | ;set comfcb to all ??? for current disk 847 | mvi b,11 ;length of fill ????????.??? 848 | dir0: mvi m,'?' 849 | inx h 850 | dcr b 851 | jnz dir0 852 | ;not a blank request, must be in comfcb 853 | dir1: mvi e,0 ;E counts directory entries 854 | push d 855 | call searchcom ;first one has been found 856 | cz nofile ;not found message 857 | dir2: jz endir 858 | ;found, but may be system file 859 | lda dcnt ;get the location of the element 860 | rrc 861 | rrc 862 | rrc 863 | ani 1100000b 864 | mov c,a 865 | ;c contains base index into buff for dir entry 866 | mvi a,sysfile ;value to A 867 | call addhcf 868 | ral ;skip if system file 869 | jc dir6 870 | ;c holds index into buffer 871 | ;another fcb found, new line? 872 | pop d 873 | mov a,e 874 | inr e 875 | push d 876 | ;e=0,1,2,3,...new line if mod 4 = 0 877 | ani 11b ;and save the test 878 | push psw 879 | jnz dirhdr0 ;header on current line 880 | call crlf 881 | push b 882 | call cselect 883 | pop b 884 | ;current disk in A 885 | adi 'A' 886 | call printbc 887 | mvi a,':' 888 | call printbc 889 | jmp dirhdr1 ;skip current line hdr 890 | dirhdr0: 891 | call blank ;after last one 892 | mvi a,':' 893 | call printbc 894 | dirhdr1: 895 | call blank 896 | ;compute position of name in buffer 897 | mvi b,1 ;start with first character of name 898 | dir3: mov a,b ;buff+a+c fetched 899 | call addhcf 900 | ani 7fh ;mask flags 901 | ;may delete trailing blanks 902 | cpi ' ' ;check for blank type 903 | jnz dir4 904 | pop psw ;may be 3rd item 905 | push psw 906 | cpi 3 ;place blank at end if not 907 | jnz dirb 908 | mvi a,9 ;first char of type 909 | call addhcf 910 | ani 7fh 911 | cpi ' ' 912 | jz dir5 913 | ;not a blank in the file type field 914 | dirb: mvi a,' ' ;restore trailing filename chr 915 | dir4: 916 | call printbc ;char printed 917 | inr b 918 | mov a,b 919 | cpi 12 920 | jnc dir5 921 | ;check for break between names 922 | cpi 9 ;for another char 923 | jnz dir3 924 | ;print a blank between names 925 | call blank 926 | jmp dir3 927 | 928 | dir5: ;end of current entry 929 | pop psw ;discard the directory counter (mod 4) 930 | dir6: call break_key ;check for interrupt at keyboard 931 | jnz endir ;abort directory search 932 | call searchn ;for another entry 933 | jmp dir2 934 | endir: ;end of directory scan 935 | pop d ;discard directory counter 936 | jmp retcom 937 | 938 | 939 | erase: 940 | call fillfcb0 ;cannot be all ???'s 941 | cpi 11 942 | jnz erasefile 943 | ;erasing all of the disk 944 | lxi b,ermsg 945 | call print 946 | call readcom 947 | lxi h,comlen ;bad input 948 | dcr m 949 | jnz ccp 950 | inx h 951 | mov a,m 952 | cpi 'Y' 953 | jnz ccp 954 | ;ok, erase the entire diskette 955 | inx h ;otherwise error at retcom 956 | shld comaddr 957 | erasefile: 958 | call setdisk 959 | lxi d,comfcb 960 | call delete 961 | inr a ;255 returned if not found 962 | cz nofile ;no file message if so 963 | jmp retcom 964 | 965 | ermsg: db "ALL (Y/N)?",0 966 | 967 | type: 968 | call fillfcb0 ;don't allow ?'s in file name 969 | jnz comerr 970 | call setdisk ;open the file 971 | call openc 972 | jz typerr ;zero flag indicates not found 973 | ;file opened, read 'til eof 974 | call crlf ;read first buffer 975 | lxi h,bptr 976 | mvi m,255 977 | type0: ;loop on bptr 978 | lxi h,bptr ;end buffer 979 | mov a,m 980 | cpi 128 981 | jc type1 ;carry if 0,1,...,127 982 | push h 983 | ;read another buffer full 984 | call diskreadc 985 | pop h ;recover address of bptr 986 | jnz typeof ;hard end of file 987 | xra a ;bptr = 0 988 | mov m,a 989 | type1: ;read character at bptr and print 990 | inr m ;bptr = bptr + 1 991 | lxi h,buff ;h,l addresses char 992 | call addh 993 | mov a,m 994 | cpi eofile 995 | jz retcom 996 | call printchar 997 | call break_key ;abort if break 998 | jnz retcom 999 | jmp type0 ;for another character 1000 | 1001 | typeof: ;end of file, check for errors 1002 | dcr a 1003 | jz retcom 1004 | call readerr 1005 | typerr: call resetdisk 1006 | jmp comerr 1007 | 1008 | save: 1009 | call getnumber ; value to register a 1010 | push psw ;save it for later 1011 | 1012 | ;should be followed by a file to save the memory image 1013 | call fillfcb0 1014 | jnz comerr ;cannot be ambiguous 1015 | call setdisk ;may be a disk change 1016 | lxi d,comfcb ;existing file removed 1017 | push d 1018 | call delete 1019 | pop d 1020 | call make ;create a new file on disk 1021 | jz saverr ;no directory space 1022 | xra a ;clear next record field 1023 | sta comrec 1024 | pop psw ;#pages to write is in a, change to #sectors 1025 | mov l,a 1026 | mvi h,0 1027 | dad h 1028 | lxi d,tran ;h,l is sector count, d,e is load address 1029 | save0: ;check for sector count zero 1030 | mov a,h ;may be completed 1031 | ora l 1032 | jz save1 1033 | dcx h ;sector count = sector count - 1 1034 | push h ;save it for next time around 1035 | lxi h,128 ;next dma address saved 1036 | dad d 1037 | push h 1038 | call setdma ;current dma address set 1039 | lxi d,comfcb 1040 | call diskwrite 1041 | pop d ;dma address, sector count 1042 | pop h 1043 | jnz saverr ;may be disk full case 1044 | jmp save0 ;for another sector 1045 | 1046 | save1: ;end of dump, close the file 1047 | lxi d,comfcb 1048 | call close 1049 | inr a ;255 becomes 00 if error 1050 | jnz retsave ;for another command 1051 | saverr: ;must be full or read only disk 1052 | lxi b,fullmsg 1053 | call print 1054 | retsave: 1055 | ;reset dma buffer 1056 | call setdmabuff 1057 | jmp retcom 1058 | fullmsg: 1059 | db "NO SPACE",0 1060 | 1061 | 1062 | rename: 1063 | ;rename a file on a specific disk 1064 | call fillfcb0 ;must be unambiguous 1065 | jnz comerr 1066 | lda sdisk ;save for later compare 1067 | push psw 1068 | call setdisk ;disk selected 1069 | call searchcom ;is new name already there? 1070 | jnz renerr3 1071 | ;file doesn't exist, move to second half of fcb 1072 | lxi h,comfcb 1073 | lxi d,comfcb+16 1074 | mvi b,16 1075 | call move0 1076 | ;check for = or left arrow 1077 | lhld comaddr 1078 | xchg 1079 | call deblank 1080 | cpi '=' ;ok if = 1081 | jz ren1 1082 | cpi la 1083 | jnz renerr2 1084 | ren1: xchg ;past delimiter 1085 | inx h 1086 | shld comaddr 1087 | ;proper delimiter found 1088 | call fillfcb0 1089 | jnz renerr2 1090 | ;check for drive conflict 1091 | pop psw ;previous drive number 1092 | mov b,a 1093 | lxi h,sdisk 1094 | mov a,m 1095 | ora a 1096 | jz ren2 1097 | ;drive name was specified. same one? 1098 | cmp b 1099 | mov m,b 1100 | jnz renerr2 1101 | ren2: mov m,b ;store the name in case drives switched 1102 | xra a ;is old file there? 1103 | sta comfcb 1104 | call searchcom 1105 | jz renerr1 1106 | 1107 | ;everything is ok, rename the file 1108 | lxi d,comfcb 1109 | call renam 1110 | jmp retcom 1111 | 1112 | renerr1:; no file on disk 1113 | call nofile 1114 | jmp retcom 1115 | renerr2:; ambigous reference/name conflict 1116 | call resetdisk 1117 | jmp comerr 1118 | renerr3:; file already exists 1119 | lxi b,renmsg 1120 | call print 1121 | jmp retcom 1122 | renmsg: db "FILE EXISTS",0 1123 | 1124 | user: 1125 | ;set user number 1126 | call getnumber ; leaves the value in the accumulator 1127 | cpi 16 ; must be between 0 and 15 1128 | jnc comerr 1129 | mov e,a ;save for setuser call 1130 | lda comfcb+1 1131 | cpi ' ' 1132 | jz comerr 1133 | call setuser ;new user number set 1134 | jmp endcom 1135 | 1136 | userfunc: 1137 | ifndef noserialize 1138 | call serialize ;check serialization 1139 | endif 1140 | ;load user function and set up for execution 1141 | lda comfcb+1 1142 | cpi ' ' 1143 | jnz user0 1144 | ;no file name, but may be disk switch 1145 | lda sdisk ;no disk name if 0 1146 | ora a 1147 | jz endcom 1148 | dcr a ;set user/disk 1149 | sta cdisk 1150 | call setdiska 1151 | call select 1152 | jmp endcom 1153 | user0: ;file name is present 1154 | lxi d,comfcb+9 ;type ' ' 1155 | ldax d 1156 | cpi ' ' 1157 | jnz comerr 1158 | push d ;.com 1159 | call setdisk 1160 | pop d 1161 | lxi h,comtype 1162 | call movename ;file type is set to .com 1163 | call openc 1164 | jz userer 1165 | ;file opened properly, read it into memory 1166 | lxi h,tran ;transient program base 1167 | load0: push h ;save dma address 1168 | xchg 1169 | call setdma 1170 | lxi d,comfcb 1171 | call diskread 1172 | jnz load1 1173 | ;sector loaded, set new dma address and compare 1174 | pop h 1175 | lxi d,128 1176 | dad d 1177 | lxi d,tranm ;has the load overflowed? 1178 | mov a,l 1179 | sub e 1180 | mov a,h 1181 | sbb d 1182 | jnc loaderr 1183 | jmp load0 ;for another sector 1184 | 1185 | load1: pop h ;end file is 1 1186 | dcr a 1187 | jnz loaderr 1188 | call resetdisk ;back to original disk 1189 | call fillfcb0 1190 | lxi h,sdisk 1191 | push h 1192 | mov a,m ;drive number set 1193 | sta comfcb 1194 | mvi a,16 ;move entire fcb to memory 1195 | call fillfcb 1196 | pop h 1197 | mov a,m 1198 | sta comfcb+16 1199 | xra a ;record number set to zero 1200 | sta comrec 1201 | lxi d,fcb 1202 | lxi h,comfcb 1203 | mvi b,33 1204 | call move0 1205 | ;move command line to buff 1206 | lxi h,combuf 1207 | bmove0: mov a,m 1208 | ora a 1209 | jz bmove1 1210 | cpi ' ' 1211 | jz bmove1 1212 | inx h ;for another scan 1213 | jmp bmove0 1214 | ;first blank position found 1215 | bmove1: mvi b,0 ;ready for the move 1216 | lxi d,buff+1 1217 | bmove2: mov a,m 1218 | stax d 1219 | ora a 1220 | jz bmove3 1221 | ;more to move 1222 | inr b 1223 | inx h 1224 | inx d 1225 | jmp bmove2 1226 | bmove3: ;b has character count 1227 | mov a,b 1228 | sta buff 1229 | call crlf 1230 | ;now go to the loaded program 1231 | call setdmabuff ;default dma 1232 | call saveuser ;user code saved 1233 | ;low memory diska contains user code 1234 | call tran ;gone to the loaded program 1235 | lxi sp,stack ;may come back here 1236 | call setdiska 1237 | call select 1238 | jmp ccp 1239 | 1240 | userer: ;arrive here on command error 1241 | call resetdisk 1242 | jmp comerr 1243 | 1244 | loaderr:;cannot load the program 1245 | lxi b,loadmsg 1246 | call print 1247 | jmp retcom 1248 | loadmsg: 1249 | db "BAD LOAD",0 1250 | comtype: 1251 | db "COM" ;for com files 1252 | 1253 | 1254 | retcom: ;reset disk before end of command check 1255 | call resetdisk 1256 | 1257 | endcom: ;end of intrinsic command 1258 | call fillfcb0 ;to check for garbage at end of line 1259 | lda comfcb+1 1260 | sui ' ' 1261 | lxi h,sdisk 1262 | ora m 1263 | ;0 in accumulator if no disk selected, and blank fcb 1264 | jnz comerr 1265 | jmp ccp 1266 | 1267 | 1268 | 1269 | ; data areas 1270 | ds 16 ;8 level stack 1271 | stack: 1272 | 1273 | ; 'submit' file control block 1274 | submit: db 0 ;00 if no submit file, ff if submitting 1275 | subfcb: db 0,"$$$ " ;file name is $$$ 1276 | db "SUB",0,0 ;file type is sub 1277 | submod: db 0 ;module number 1278 | subrc: ds 1 ;record count filed 1279 | ds 16 ;disk map 1280 | subcr: ds 1 ;current record to read 1281 | 1282 | ; command file control block 1283 | comfcb: ds 32 ;fields filled in later 1284 | comrec: ds 1 ;current record to read/write 1285 | dcnt: ds 1 ;disk directory count (used for error codes) 1286 | cdisk: ds 1 ;current disk 1287 | sdisk: ds 1 ;selected disk for current operation 1288 | ;none=0, a=1, b=2 ... 1289 | bptr: ds 1 ;buffer pointer 1290 | end ccploc 1291 | --------------------------------------------------------------------------------