0001 ;=============================================================== 0002 ; 0003 ; INCLUDE input-ref output-ref /drives 0004 ; 0005 ; Copies the input file to the output. Where an input line has 0006 ; an Include command, the named file is merged into the output. 0007 ; Segments of files, delimited by Start and End commands, can 0008 ; be included. No file or segment will be included twice. 0009 ; 0010 ; input-ref :: [x:] inputname [.typ] 0011 ; 0012 ; If the drivecode x: is omitted, the default drive is used. An 0013 ; input filename is required. A filetype is not required. 0014 ; 0015 ; output-ref :: [y:] [outputname] [.typ] 0016 ; 0017 ; An omitted part of the output fileref is supplied from the 0018 ; input-ref. Thus the default drive is the input drive, the 0019 ; default name is the input name, and the default type is the 0020 ; input type. If all are omitted, the output file replaces the 0021 ; input file. 0022 ; 0023 ; /drives :: [ /xyz... ] 0024 ; 0025 ; Specifies the drives to be searched for an included file, and 0026 ; the order of the search. "/cb" specifies that the program is 0027 ; to look first on the C: drive and then, if the file is not 0028 ; found, to look on the B: drive. If the parameter is omitted, 0029 ; the program searches only on the default drive. If the 0030 ; parameter is given, the program searches only those drives. 0031 ; 0032 ; The three commands (Include, Start, End) are recognized when 0033 ; they are preceded by a trigger character, "#". The commands 0034 ; (using = for #) are: 0035 ; 0036 ; =include filename[.typ][,unitname] 0037 ; =start unitname 0038 ; =end unitname 0039 ; 0040 ; All letters are treated as uppercase. A unitname may be as 0041 ; much as 19 bytes long. A drivecode may be given but it will 0042 ; be ignored. See this program for examples of use. 0043 ; ***************************************************** 0044 ; * This program was originally published in * 0045 ; * A PROGRAMMER'S NOTEBOOK * 0046 ; * Utilities for CP/M-80 * 0047 ; * by David E. Cortesi * 0048 ; * Copyright (C) Reston Publishing Company Inc. 1983 * 0049 ; ***************************************************** 0050 ;=============================================================== 0051 MACLIB CPMEQU 0052 MACLIB PROG 0053 PROLOG 0054 ;--------------------------------------------------------------- 0055 ; Define the Name table and a Name record: 0056 NameTable dw 0 ; NTspace, at end of program 0057 NameCount db 0 ; count of entries in table 0058 NextName dw 0 ; address of next entry 0059 MaxNames equ 128 0060 NameFile equ 0 ; entry starts with fileref of 0061 LengthFileRef equ 12 ; ..12 bytes, then the 0062 NameUnit equ LengthFileRef ; Unit name, a string of 0063 LengthUnit equ 19 ; up to 19 bytes. 00h at end 0064 LengthName equ LengthFileRef+LengthUnit+1 ; ..makes 32. 0065 NTsize equ LengthName*MaxNames 0066 TempName equ CpmFCB ; scratch Name-building area 0067 ;--------------------------------------------------------------- 0068 ; Define the File table and a File record: 0069 FileTable dw 0 ; FTspace, after NTspace 0070 FileCount db 0 ; count of active Files 0071 NextFile dw 0 ; address of next entry 0072 MaxFiles equ 8 0073 FileFlags equ 0 ; File has a flag byte, 0074 FileIndex equ 1 ; then a buffer index byte, 0075 FileFCB equ 2 ; an FCB of 35 bytes, 0076 LengthFCB equ 35 ; then a 1-record buffer. 0077 FileBuffer equ FileFCB+LengthFCB 0078 LengthFile equ 1+1+LengthFCB+128 0079 FTsize equ LengthFile*MaxFiles 0080 ;--------------------------------------------------------------- 0081 ; Define the drivecode list, trigger character, and LineBuffer: 0082 DriveList ds 17 ; to 16 drives, and 00h to end. 0083 MaxDrives equ 16 0084 Trigger equ '#' 0085 LineBuffer dw 0 ; address of line buffer 0086 LBsize equ 2048 ; ..and size of it 0087 ; 0088 ; #include utilio.inc,OutVars 0089 ; #include utilio.inc,FileMessages 0090 MsgNames db 'No space to record this unit.$' 0091 MsgNesting db 'Includes nested too deeply.$' 0092 MsgBadStmt db 'Can''t make sense of this command.$' 0093 MsgBadDrive db 'Invalid "/drives" parameter.$' 0094 MsgNoUnit db 'The named unit isn''t in the file.$' 0095 MsgIgnored db ' Ignoring command.',AsciiCR,AsciiLF,'$' 0096 ;=============================================================== 0097 ;Main Program: 0098 Main: 0099 push h ; save address of top storage 0100 ; 0101 SERVICE BdosDrive ; get default drive 0102 inr a ; make suitable for FCB use 0103 lxi d,DriveList ; initialize drive list to 0104 stax d ; ..the default drive 0105 inx d 0106 push psw ; (save it for the input ref) 0107 ; 0108 ; if (/drive given)... 0109 lxi h,CpmTail+1 ; look for.. 0110 call CmdCharOpt ; "/x.." in the command tail 0111 JRNZ MainDrive3 ; (there was none) 0112 ; 0113 ; ..then make a list of drivecodes 0114 ; 0115 mvi b,MaxDrives+1 ; set limit of drive loop 0116 dcx d ; overlay default drive 0117 MainDrive1: 0118 call Delimiter ; at end of drive letters? 0119 JRZ MainDrive2 ; (looks like it) 0120 cpi 'P'+1 ; no. Is this a drive letter? 0121 JRNC MainBadDrive 0122 sui 'A' 0123 JRC MainBadDrive 0124 inr a ; add 1 for FCB use 0125 stax d ; put the drive in the list, 0126 inx d ; ..advance list-pointer, 0127 inx h ; ..and tail-pointer, 0128 DJNZ MainDrive1 ; and continue up to 16 of them 0129 ; 0130 MainBadDrive: ; 2 few, 2 many, or bad drives 0131 ABORT MsgBadDrive 0132 ; 0133 MainDrive2: ; collected drive letters... 0134 mov a,b 0135 cpi MaxDrives+1 ; ..didn't we? 0136 JRNC MainBadDrive ; (no, just "/", no "x") 0137 ; 0138 MainDrive3: ; the drivelist is complete 0139 xra a 0140 stax d ; ..terminate the list 0141 ; 0142 ; initialize the Line Buffer 0143 ; 0144 lxi h,LBspace 0145 shld LineBuffer ; set the buffer address, 0146 mvi m,AsciiLF ; put a null line in it 0147 ; 0148 ; initialize the Name Table 0149 ; 0150 lxi h,NTspace 0151 shld NameTable ; address in NameTable 0152 mvi a,1 0153 sta NameCount ; initially, one entry 0154 lxi d,LengthName 0155 dad d 0156 shld NextName ; entry after input-ref is 2 0157 ; 0158 ; initialize the File Table 0159 ; 0160 lxi h,FTspace 0161 shld FileTable ; address in FileTable 0162 sta FileCount ; initially, one entry 0163 lxi d,LengthFile 0164 dad d 0165 shld NextFile ; entry after input File is 2 0166 ; 0167 ; prepare a File entry for the input file 0168 ; 0169 lhld FileTable ; HL-->File 0170 push h ; (save that) 0171 inx h ; HL-->FileIndex 0172 mvi m,128 ; ..initially, Index=128 0173 inx h 0174 xchg ; DE-->FileFCB 0175 lxi h,CpmFcb ; HL-->input fileref 0176 lxi b,LengthFileref ; move just the fileref 0177 call MoveHtoD 0178 lxi b,LengthFCB-LengthFileref 0179 call FillZero ; ..and zero the rest 0180 ; 0181 ; Open the input file, abort if it doesn't exist 0182 ; 0183 lxi h,CpmFcb+1 ; was a file even given? 0184 call Delimiter 0185 JRNZ MainOp1 ; (yes) 0186 ABORT MsgNoName 0187 MainOp1: 0188 pop d ; DE-->File 0189 pop b ; B = the default drivecode 0190 lda CpmFcb ; but wait..was one specified? 0191 ora a 0192 JRNZ MainOp2 ; (yes..use it) 0193 mov a,b ; (no..use the system default) 0194 MainOp2: 0195 call OpenFCB ; open File with drivecode 0196 JRZ MainName ; (open worked) 0197 ABORT MsgNoFile 0198 ; 0199 ; prepare a Name entry for the input file 0200 ; 0201 MainName: 0202 lhld NameTable 0203 lxi d,CpmFcb 0204 xchg 0205 lxi b,LengthFCB+1 ; copy through a 00 byte 0206 call MoveHtoD 0207 ; 0208 ; prepare the output mechanism 0209 ; 0210 lhld FileTable 0211 mov b,h 0212 mov c,l ; BC-->the input File record 0213 inx b 0214 inx b ; BC-->the default fileref 0215 lxi d,OBspace ; DE-->output buffer 0216 pop h ; HL-->output maximum 0217 call SetUpOutput 0218 ; 0219 ; process the input file: OneFile(FileTable[1],NameTable[1]) 0220 ; 0221 lhld NameTable 0222 mov b,h 0223 mov c,l ; BC-->Name 0224 lhld FileTable 0225 xchg ; DE-->File 0226 call OneFile 0227 ; 0228 ; finish the output file 0229 ; 0230 call FinishOutput 0231 ret 0232 ;=============================================================== 0233 ; 0234 ; OneFile(File,Name) -- process all of one included file 0235 ; 0236 ; The parameters are: 0237 ; BC--> a Name record: fileref and unitname 0238 ; DE--> a File record: the (open) file and buffer 0239 ; 0240 ; The registers are used as follows: 0241 ; 0242 ; A : general work 0243 ; BC : Name, or a temporary Name record (N) 0244 ; DE : File, or a temporary File (F), or a keyword string 0245 ; HL : running text pointer while scanning the line (T) 0246 ; 0247 ; The three boolean flags are kept in the first byte of File. 0248 ; 0249 ;=============================================================== 0250 Searching equ 80h ; looking for a certain unit 0251 Skipping equ 40h ; skipping a previous unit 0252 Ended equ 20h ; "End" is reserved by assembler 0253 ; 0254 KeyStart db 'START',0 0255 KeyEnd db 'END',0 0256 KeyInclude db 'INCLUDE',0 0257 ; 0258 OneFile: 0259 push psw 0260 push b 0261 push d 0262 push h 0263 call ShowLine ; document progress at console 0264 ; ------------------------- 0265 lxi h,NameUnit 0266 dad b ; HL --> Name.Unit 0267 mov a,m 0268 ora a ; if Name.Unit is null, 0269 JRZ OF2 ; then Searching := false 0270 mvi a,Searching ; else Searching := true 0271 OF2: stax d ; (initialize flags) 0272 ;-------------------------- 0273 OneWhile: 0274 ldax d 0275 ani Ended ; while (not Ended) 0276 jnz OneDone 0277 call GetLine ; and (not GetLine(File,T)) 0278 jz OneDone 0279 ;-------------------------- 0280 ldax d ; if not Searching or Skipping 0281 ani Searching+Skipping 0282 jnz OFSorS 0283 ;-------------------------- 0284 mov a,h ; (optimization: if T=0, there 0285 ora a ; was no trigger, hence no 0286 JRNZ OFStart ; keyword to look at. Put the 0287 call PutLine ; line and iterate at once) 0288 JMPR OneWhile 0289 ;-------------------------- 0290 OFStart: 0291 push d ; if (Keyword("START",T)) 0292 lxi d,KeyStart 0293 call Keyword 0294 pop d 0295 JRNZ OFnotStart 0296 ;--------------------------- 0297 push b ; (save our Name.. 0298 push d ; ..and File) 0299 mov d,b ; (pass Name in DE, and 0300 mov e,c 0301 lxi b,TempName ; ..N in BC) 0302 call RecordUnit ; if (RecordUnit(N,Name,T)) 0303 pop d ; (recover our File) 0304 JRNZ OFStart2 0305 call Lookup ; if (Lookup(N)) 0306 JRNZ OFStart1 0307 ldax d 0308 ori Skipping 0309 stax d ; Skipping := true 0310 JMPR OFStart3 0311 OFStart1: ; else 0312 call AddName ; AddName(N) 0313 OFStart2: 0314 call PutLine ; (not skipping, write line) 0315 OFStart3: 0316 pop b ; (recover our Name) 0317 jmp OneWhile 0318 ;--------------------------- 0319 OFnotStart: ; else not # start, so 0320 call PutLine ; the line goes to the output 0321 OFInc: 0322 push d ; if Keyword("INCLUDE",T) 0323 lxi d,KeyInclude 0324 call Keyword 0325 pop d 0326 JRNZ OFEnd 0327 ;--------------------------- 0328 push b ; (save Name.. 0329 push d ; ..and File) 0330 lxi b,TempName 0331 call RecordName ; if (RecordName(N,T) 0332 JRNZ OFIncZ 0333 call Lookup ; if (not Lookup(N)) 0334 JRZ OFIncZ 0335 call AddName ; if (AddName(N)) 0336 cz GetFile ; if (GetFile(F,N)) 0337 JRNZ OFIncZ 0338 call OpenFile ; if (OpenFile(F)) 0339 cz OneFile ; ..then recurse 0340 call RelFile 0341 OFIncZ: 0342 pop d 0343 pop b ; (recover Name and File) 0344 jmp OneWhile 0345 ;--------------------------- 0346 OFEnd: 0347 push d ; if (Keyword("END",T)) 0348 lxi d,KeyEnd 0349 call Keyword 0350 pop d 0351 jnz OneWhile ; (a trigger, but no keyword) 0352 ;--------------------------- 0353 call EqualUnit ; if (EqualUnit(Name,T)) 0354 jnz OneWhile 0355 ldax d 0356 ori Ended 0357 stax d ; Ended := true 0358 jmp OneWhile 0359 ;-------------------------------------- 0360 OFSorS: ; else {Searching or Skipping} 0361 mov a,h ; (optimization: if no trigger, 0362 ora a ; there's no use in looking 0363 jz OneWhile ; for start or end.) 0364 ldax d 0365 ani Searching 0366 JRZ OFSkip 0367 ;--------------------------- 0368 OFSearch: 0369 push d ; if (Searching) then 0370 lxi d,KeyStart ; if (Keyword("START",T) 0371 call Keyword 0372 pop d 0373 jnz OneWhile 0374 ; 0375 call EqualUnit ; if (EqualUnit(Name,T)) 0376 jnz OneWhile 0377 call PutLine ; PutLine 0378 ldax d 0379 ani 255-Searching 0380 stax d ; Searching := false 0381 jmp OneWhile 0382 ;--------------------------- 0383 OFSkip: ; else {Skipping} 0384 push d ; if (Keyword("END",T)) 0385 lxi d,KeyEnd 0386 call Keyword 0387 pop d 0388 jnz OneWhile 0389 ; 0390 push b ; (save our Name) 0391 lxi b,TempName ; (Skipped unitname still there) 0392 call EqualUnit ; if (EqualUnit(N,T)) 0393 JRNZ OFSkip2 0394 ldax d 0395 ani 255-Skipping 0396 stax d ; Skipping := false 0397 OFSkip2: 0398 pop b 0399 jmp OneWhile 0400 ;--------------------------------------------- 0401 OneDone: ; end while 0402 ldax d ; if (Searching) then 0403 ani Searching 0404 JRZ OneFileZ 0405 lhld LineBuffer ; (don't display the last line 0406 mvi m,AsciiLF ; ..of the file just searched) 0407 lxi d,MsgNoUnit ; say we can't find the unit 0408 call ReportError 0409 OneFileZ: 0410 pop h 0411 pop d 0412 pop b 0413 pop psw 0414 ret 0415 ;--------------------------------------------------------------- 0416 ; AddName: Add BC-->Name record to the list of all processed 0417 ; units. If the list is full, report the error and return 0418 ; false (not Z). Otherwise return BC--> the entered name, and 0419 ; true (Z) status. 0420 ; preserves -- DE, HL 0421 ; returns -- BC-->Name record in table of names 0422 ; Z set true or false. 0423 ;--------------------------------------------------------------- 0424 AddName: 0425 push h 0426 push d 0427 ; see if there is room 0428 lda NameCount 0429 cpi MaxNames 0430 JRNC AddNameErr 0431 ; copy the name 0432 mov d,b ! mov e,c 0433 lhld NextName 0434 xchg ; DE-->next name, HL-->input 0435 push d ; (save -->Name) 0436 lxi b,LengthName 0437 call MoveHtoD 0438 xchg ; HL-->next free name 0439 shld NextName ; ..update it 0440 lxi h,NameCount 0441 inr m ; ..and step the count 0442 xra a ; return true 0443 pop b ; ..and BC-->new Name 0444 AddNameZ: 0445 pop d 0446 pop h 0447 ret 0448 AddNameErr: 0449 lxi d,MsgNames 0450 call ReportError 0451 ori -1 ; return false 0452 JMPR AddNameZ 0453 ;--------------------------------------------------------------- 0454 ; EqualUnit: compare the unitname in BC-->Name to the text 0455 ; addressed by HL. If the strings are equal, and if the text 0456 ; name is delimited, return true (Z). 0457 ; preserves -- BC, DE 0458 ; returns -- Z flag set true for equality 0459 ; HL advanced an unknown amount 0460 ;--------------------------------------------------------------- 0461 EqualUnit: 0462 push d ; save work register 0463 ; 0464 xchg ; DE-->text 0465 lxi h,NameUnit 0466 dad b ; HL-->Name.Unit 0467 ; 0468 xchg ; DE-->Name.Unit, HL-->text 0469 call SkipWhite ; skip leading blanks in text 0470 call CmpStrText ; Unit-string vs. HL text 0471 JRNZ EqualMiss 0472 call Delimiter ; equal to end of DE string, 0473 ; ..see if text terminated 0474 EqualMiss: 0475 pop d 0476 ret 0477 ;--------------------------------------------------------------- 0478 ; GetFile: return the address of the next free File in DE. 0479 ; Fill it in with the fileref from BC-->Name. If all File 0480 ; records are in use, report too-deep nesting of includes. 0481 ; preserves -- BC, HL 0482 ; returns -- DE-->File, 0483 ; Z set true, or false for error 0484 ;--------------------------------------------------------------- 0485 GetFile: 0486 push h 0487 push b 0488 ; ; see if there is a free File 0489 lda FileCount 0490 cpi MaxFiles 0491 JRNC GetFileErr 0492 ; 0493 lhld NextFile 0494 mov d,b 0495 mov e,c 0496 xchg ; HL-->Name, DE-->File 0497 push d ; (save -->File) 0498 inx d 0499 inx d ; DE-->File.FCB 0500 lxi b,LengthFileref 0501 call MoveHtoD ; set fileref in FCB 0502 lhld NextFile 0503 lxi b,LengthFile 0504 dad b 0505 shld NextFile ; update -->next File 0506 lxi h,FileCount 0507 inr m ; ..and the count 0508 xra a ; return true, 0509 pop d ; ..and DE-->File 0510 GetFileZ: 0511 pop b 0512 pop h 0513 ret 0514 GetFileErr: 0515 lxi d,MsgNesting 0516 call ReportError 0517 ori -1 ; return false 0518 JMPR GetFileZ 0519 ;--------------------------------------------------------------- 0520 ; GetLine: read a complete line from DE-->File. Put the data in 0521 ; the LineBuffer. Set HL to the address of the first trigger 0522 ; character seen. If end of file happens, return true. 0523 ; preserves -- BC, DE 0524 ; returns -- Z flag true on end of file 0525 ; HL=0 if no trigger, else HL-->trigger+1 0526 ; Note: this code takes Linefeed as marking the end of a line. 0527 ; MBASIC lines that contain embedded LFs will be read in pieces, 0528 ; and therefore an MBASIC include should be in a complete line. 0529 ; Files that contain only CR to mark line-end will crash us. 0530 ; This code assumes that a LF will immediately precede CpmEof-- 0531 ; a partial line at file end will not appear in the output. 0532 ;--------------------------------------------------------------- 0533 GetLine: 0534 push b 0535 lxi b,0 ; set up BC as the trigger addr. 0536 lhld LineBuffer ; HL bases next byte 0537 GetLine1: 0538 call GetChar 0539 cpi CpmEof ; should happen on first call 0540 JRZ GetLineDone 0541 ; 0542 mov m,a ; byte to buffer 0543 inx h ; ..and step pointer 0544 cpi AsciiLF ; end of line? 0545 JRZ GetLineDone 0546 ; 0547 cpi Trigger ; trigger character? 0548 JRNZ GetLine1 ; ..continue if not 0549 ; 0550 mov a,b 0551 ora a ; have we seen a trigger yet? 0552 JRNZ GetLine1 ; (yes, ignore the 2nd) 0553 mov b,h ; no. Save text pointer as 0554 mov c,l ; ..the trigger pointer 0555 JMPR GetLine1 0556 GetLineDone: 0557 mov h,b ! mov l,c ; return trigger pointer in HL 0558 cpi CpmEof ; and Z true on end of file 0559 pop b 0560 ret 0561 ;--------------------------------------------------------------- 0562 ; Keyword: Compare DE-->string to the text addressed by HL. Make 0563 ; sure the text keyword is terminated with a blank or tab. 0564 ; On a match, update HL past the keyword. 0565 ; preserves -- BC, DE 0566 ; returns -- Z flag true on match 0567 ; HL updated or not 0568 ;--------------------------------------------------------------- 0569 Keyword: 0570 push d 0571 push h 0572 call CmpStrText ; equal for length of keyword? 0573 cz WhiteSpace ; and terminated by blank/tab? 0574 JRNZ Keyword2 ; (no) 0575 xthl ; ..yes, return updated HL 0576 Keyword2: 0577 pop h 0578 pop d 0579 ret 0580 ;--------------------------------------------------------------- 0581 ; Lookup: Search the list of all processed Names for a match to 0582 ; BC-->Name. Return true (Z) if a match is found, else false. 0583 ; preserves -- BC, DE, HL 0584 ; returns -- Z flag true if Name appears in the list. 0585 ; Note: the first byte of a Name is a drivecode as in an FCB. 0586 ; It isn't significant, might be 00 and so stop the compare, 0587 ; and so is not compared. 0588 ;--------------------------------------------------------------- 0589 Lookup: 0590 push b 0591 push d 0592 push h 0593 ; 0594 mov d,b 0595 mov e,c ; DE-->comparand 0596 inx d ; ..filename,type,unit,00h 0597 lhld NameTable ; HL-->NameTable[ j ] 0598 inx h ; ..plus 1 to avoid drivecodes 0599 lda NameCount 0600 mov b,a ; B = count of names 0601 ; 0602 Lookup1: 0603 push h ; CmpString alters DE, HL 0604 push d 0605 call CmpString ; compare [D+] :: [H+] 0606 pop d 0607 pop h 0608 JRZ LookupHit ; (found a matching entry) 0609 push d 0610 lxi d,LengthName 0611 dad d ; HL-->next NameTable 0612 pop d 0613 DJNZ Lookup1 0614 ; the name is unknown 0615 ori -1 ; ..return false 0616 ; 0617 LookupHit: ; the name was found 0618 ; ..return Z set 0619 pop h 0620 pop d 0621 pop b 0622 ret 0623 ;--------------------------------------------------------------- 0624 ; OpenFile: try to open the file defined by DE-->File, using the 0625 ; list of drivecodes given as program parameters. Return true 0626 ; if the open is a success. Otherwise report file not found and 0627 ; return false. 0628 ; preserves -- BC, DE, HL 0629 ; returns -- Z flag set (true) if the open succeeds 0630 ; DE-->File.FCB updated by CP/M BDOS 0631 ;--------------------------------------------------------------- 0632 OpenFile: 0633 push b 0634 push h 0635 push d ; (save -->File) 0636 ; ; prepare the FCB for use 0637 inx d ; DE-->File.Index 0638 mvi a,128 ; ..force read on first GetChar 0639 stax d 0640 inx d ; DE-->actual FCB 0641 ; 0642 lxi h,LengthFileref 0643 dad d 0644 xchg ; DE-->FCB "ex" byte 0645 lxi b,LengthFCB-LengthFileref 0646 call FillZero ; zero out rest of the FCB 0647 ; 0648 pop d ; (recover DE-->File.. 0649 push d ; ..and save it again) 0650 lxi h,DriveList 0651 mov a,m ; first drivecode to try 0652 OpenLoop: 0653 call OpenFCB ; try an open 0654 JRZ OpenDone ; (it worked) 0655 inx h 0656 mov a,m ; ok, try the next drivecode 0657 ora a ; ..if there is one 0658 JRNZ OpenLoop 0659 ; can't find the file... 0660 lxi d,MsgNoFile 0661 call ReportError ; ..tell about it 0662 ori -1 ; return non-Z (false) 0663 OpenDone: 0664 pop d 0665 pop h 0666 pop b 0667 ret 0668 ;--------------------------------------------------------------- 0669 ; OpenFCB: Given DE-->File (with a prepared FCB), and a drive- 0670 ; code in A, try to open the file. 0671 ; preserves -- BC, DE, HL 0672 ; returns -- Z flag true if the open succeeds 0673 ;--------------------------------------------------------------- 0674 OpenFCB: 0675 push b 0676 push d 0677 push h 0678 ; 0679 lxi h,FileFCB 0680 dad d 0681 xchg ; DE-->the FCB 0682 stax d ; insert the drivecode 0683 mvi c,BdosOpen 0684 call Bdos 0685 ora a ; failure is FFh in A 0686 ; 0687 pop h 0688 pop d 0689 pop b 0690 rm ; return non-Z if A=FFh 0691 xra a ; return Z if A=0, 1, 2, 3 0692 ret 0693 ;--------------------------------------------------------------- 0694 ; Putline: write the line in LineBuffer to the output file. Use 0695 ; a Linefeed as the signal for end of line (see GetLine notes). 0696 ; preserves -- all 0697 ;--------------------------------------------------------------- 0698 PutLine: 0699 push psw 0700 push h 0701 lhld LineBuffer 0702 PutLine1: 0703 mov a,m 0704 call PutChar 0705 inx h 0706 cpi AsciiLF 0707 JRNZ PutLine1 0708 ; 0709 pop h 0710 pop psw 0711 ret 0712 ;--------------------------------------------------------------- 0713 ; RecordName: extract the fileref and optional unitname from 0714 ; the text addressed by HL. Format them into BC-->Name record. 0715 ; If there is bad syntax, report it to the console. 0716 ; preserves -- BC, DE 0717 ; returns -- Z true if the syntax was ok 0718 ;--------------------------------------------------------------- 0719 RecordName: 0720 push b 0721 push d 0722 ; 0723 mov d,b 0724 mov e,c ; use DE-->Name record 0725 ; 0726 call SkipWhite ; get over any blanks 0727 call Delimiter ; ensure something is there 0728 JRZ RecNameBad ; (not fileref -- end of line?) 0729 ; 0730 call ParseFileRef ; format fileref into Name 0731 JRNZ RecNameBad ; (it was objectionable somehow) 0732 ; 0733 cpi ',' ; if a comma follows, 0734 JRNZ RecNameNullU ; (it didn't) 0735 inx h ; ..step over it and 0736 call ParseUnit ; ..format the Unit as well 0737 JRNZ RecNameBad 0738 ; ; all ok, return Z 0739 RecNameDone: 0740 pop d 0741 pop b 0742 ret 0743 ; 0744 RecNameNullU: ; fileref only, no ",unit" 0745 xchg ; save HL, HL->Name 0746 lxi b,NameUnit 0747 dad b ; HL->NameUnit 0748 xra a 0749 mov m,a ; terminate the empty string 0750 xchg ; restore HL 0751 JMPR RecNameDone ; ..and exit with Z 0752 ; 0753 RecNameBad: ; error: report to console 0754 lxi d,MsgBadStmt 0755 call ReportError 0756 ori -1 ; return false 0757 JMPR RecNameDone 0758 ;--------------------------------------------------------------- 0759 ; RecordUnit : Copy the fileref from DE-->Name into BC-->Name. 0760 ; Then get a unitname from HL-->text, and format it into the 0761 ; BC-->Name record. If bad syntax occurs, report an error and 0762 ; return false, else return true (Z). 0763 ; preserves -- BC, DE 0764 ; returns -- Z flag true if syntax is ok. 0765 ; (This routine is used when a start command is found in the 0766 ; current file, to prepare a Name from the current file's Name 0767 ; and the name of the starting unit) 0768 ;--------------------------------------------------------------- 0769 RecordUnit: 0770 push d 0771 push h ; save the text address 0772 push b ; save -->output Name 0773 ; 0774 xchg ; reverse regs for MoveHtoD.. 0775 mov d,b 0776 mov e,c ; DE-->output, HL-->input 0777 lxi b,LengthFileref ; length to copy 0778 call MoveHtoD ; copy fileref to Name 0779 ; 0780 pop b ; recover BC-->output Name 0781 pop h ; recover text pointer 0782 call SkipWhite ; get over any spaces/tabs 0783 call ParseUnit ; format unitname to BC-->Name 0784 JRZ RecUnitDone 0785 ; bad or missing unitname 0786 lxi d,MsgBadStmt 0787 call ReportError 0788 ori -1 ; return false 0789 RecUnitDone: 0790 pop d 0791 ret 0792 ;--------------------------------------------------------------- 0793 ; ParseUnit: put the unitname in the text addressed by HL into 0794 ; the NameUnit field of BC-->Name. If the syntax is invalid, 0795 ; type a report at the console and return false. 0796 ; preserves -- BC, DE 0797 ; alters -- HL updated to last byte examined 0798 ; returns -- Z flag true if unitname syntax is valid. 0799 ;--------------------------------------------------------------- 0800 ParseUnit: 0801 push b 0802 push d 0803 call Delimiter ; if end of line or delimiter 0804 JRNZ ParseUnit2 ; (was not) 0805 ori -1 ; ..force not-Z condition, 0806 JMPR ParseUnit3 ; ..and quit 0807 ; 0808 ParseUnit2: ; HL-->non-delimiter 0809 xchg ; save text pointer 0810 lxi h,NameUnit 0811 dad b 0812 xchg ; DE-->Name.Unit 0813 ; 0814 push d ; save that.. 0815 lxi b,LengthUnit ; ..and zero the whole field 0816 call FillZero 0817 pop d ; DE-->Name.Unit, HL-->text 0818 mov b,c ; B := LengthUnit 0819 call MoveHToDelim ; copy unit to 19 bytes or delim 0820 call Delimiter ; verify end of unitname 0821 ParseUnit3: 0822 pop d 0823 pop b 0824 ret 0825 ;--------------------------------------------------------------- 0826 ; RelFile: release DE-->File for use. Actually, we assume that 0827 ; File records are gotten and released in strict FIFO order. 0828 ; preserves -- all 0829 ;--------------------------------------------------------------- 0830 RelFile: 0831 push b 0832 push h 0833 lhld NextFile 0834 lxi b,-LengthFile 0835 dad b 0836 shld NextFile 0837 lxi h,FileCount 0838 dcr m 0839 pop h 0840 pop b 0841 ret 0842 ;--------------------------------------------------------------- 0843 ; ReportError: display the current line -- if it is an include 0844 ; command, it will then show up twice, too bad -- and then the 0845 ; message addressed by DE. 0846 ; preserves -- all 0847 ;--------------------------------------------------------------- 0848 ReportError: 0849 push psw 0850 push d 0851 call ShowLine ; display the line (again?) 0852 mvi a,AsciiBEL ; toot the terminal 0853 call TypeChar 0854 call TypeMessage ; type the message 0855 lxi d,MsgIgnored ; ..and "Ignoring" 0856 call TypeMessage 0857 pop d 0858 pop psw 0859 ret 0860 ;--------------------------------------------------------------- 0861 ; ShowLine: display the current input line at the console. Show 0862 ; not over 80 bytes of it, and make sure that the display ends 0863 ; with both a CR and a LF. 0864 ; preserves -- all 0865 ;--------------------------------------------------------------- 0866 ShowLine: 0867 push psw 0868 push b 0869 push h 0870 ; 0871 lhld LineBuffer 0872 mvi b,80 ; B holds max byte count 0873 xra a ; dummy up a "prior" byte 0874 ShowLine1: 0875 mov c,a ; save prior output byte 0876 mov a,m 0877 call TypeChar ; type current byte 0878 cpi AsciiLF ; last one in a line? 0879 JRZ ShowLine2 ; (yes, finish line) 0880 inx h 0881 DJNZ ShowLine1 ; continue, up to 80 bytes 0882 ; 0883 mvi A,AsciiLF ; line longer than 80, force LF 0884 call TypeChar 0885 ShowLine2: ; a LF has been typed... 0886 mvi a,AsciiCR ; was prior char a CR? 0887 cmp c 0888 cnz TypeChar ; (no, type one now) 0889 ; 0890 pop h 0891 pop b 0892 pop psw 0893 ret 0894 ;--------------------------------------------------------------- 0895 ; GetChar: Return the next character from DE-->File. The logic 0896 ; is the same as the usual utility GetChar, but complicated by 0897 ; having to use the File record instead of InFCB and CpmBuffer. 0898 ; preserves -- BC, DE, HL 0899 ; returns -- A contains next byte. 0900 ;--------------------------------------------------------------- 0901 GetChar: 0902 push h 0903 push d 0904 ; 0905 inx d ; DE-->FileIndex 0906 ldax d 0907 inr a 0908 jp GetChar2 0909 ; 0910 ; FileIndex has reached 128 -- the buffer is empty. Read one 0911 ; record into FileBuffer, with CpmEof in it so that logical 0912 ; and physical EOF are alike. 0913 ; 0914 push b 0915 push d ; (save -->FileIndex) 0916 inx d ; DE-->FileFCB 0917 push d ; (save that) 0918 lxi h,FileBuffer-FileFCB 0919 dad d ; HL-->FileBuffer 0920 mvi m,CpmEof 0921 xchg ; DE-->FileBuffer 0922 mvi c,BdosSetBuffer 0923 call Bdos 0924 pop d ; DE-->FileFCB 0925 mvi c,BdosRead 0926 call Bdos 0927 pop d ; DE-->FileIndex 0928 pop b 0929 xra a ; Index := 0 0930 ; 0931 ; At this point there is either data or CpmEof in 0932 ; FileBuffer[ A ], and DE-->FileIndex. 0933 ; 0934 GetChar2: 0935 stax d ; update Index 0936 adi FileBuffer-FileIndex 0937 mov l,a 0938 mvi h,0 0939 dad d ; HL-->FileBuffer[FileIndex] 0940 mov a,m 0941 cpi CpmEof 0942 JRNZ GetChar3 0943 xchg ; at end of file, back up the 0944 dcr m ; index to stay there. 0945 GetChar3: 0946 pop d 0947 pop h 0948 ret 0949 ;--------------------------------------------------------------- 0950 ; Included subroutines: 0951 ; #include textlib.inc,CmpString 0952 ; #include textlib.inc,CmpStrText 0953 ; #include textlib.inc,Delimiter 0954 ; #include textlib.inc,SkipWhite 0955 ; #include textlib.inc,UpperCase 0956 ; #include textlib.inc,WhiteSpace 0957 ; #include textlib.inc,MoveHtoD 0958 ; #include cmdparse.inc,ParseFileRef 0959 ; #include cmdparse.inc,MoveHtoDelim 0960 ; #include cmdparse.inc,CmdCharOpt 0961 ; #include TypeSubs.inc,TypeCommon 0962 ; #include utilio.inc,PutChar 0963 ; #include utilio.inc,SetUpOutput 0964 ;=============================================================== 0965 ; Main data areas: 0966 NTspace ds NTsize ; space for Name Table 0967 FTspace ds FTsize ; space for File Table 0968 LBspace ds LBsize ; space for a good long line 0969 OBspace ds 1024 ; minimal sort of buffer 0970 ; enable the following line in MP/M 0971 ; db 0 0972 end * CROSS-REFERENCE * def. val. symbol and uses * 0424 0549 ADDNAME CALL-312 -335 * 0448 056D ADDNAMEERR JRNC-430 * 0444 056A ADDNAMEZ JMPR-452 * ---- 0007 ASCIIBEL MVI-852 * ---- 000D ASCIICR DB-95 MVI-886 * ---- 000A ASCIILF DB-95 MVI-146 -406 CPI-544 -706 -878 MVI-883 * ---- 0005 BDOS CALL-684 -923 -926 * ---- 0019 BDOSDRIVE SERVICE-101 * ---- 000F BDOSOPEN MVI-683 * ---- 0014 BDOSREAD MVI-925 * ---- 001A BDOSSETBUFFER MVI-922 * ---- 0847 CMDCHAROPT CALL-110 * ---- 077F CMPSTRING CALL-605 * ---- 0789 CMPSTRTEXT CALL-470 -572 * ---- 001A CPMEOF CPI-539 -558 MVI-920 CPI-941 * ---- 005C CPMFCB EQU-66 LXI-175 -183 LDA-190 LXI-203 * ---- 0080 CPMTAIL LXI-109 * ---- 07A8 DELIMITER CALL-118 -184 -472 -727 -803 -820 * 0082 0160 DRIVELIST LXI-103 -650 * 0252 0020 ENDED ANI-275 ORI-356 * 0474 058B EQUALMISS JRNZ-471 * 0461 0578 EQUALUNIT CALL-353 -375 -392 * 0077 0025 FILEBUFFER LXI-918 ADI-936 * 0070 015D FILECOUNT STA-162 LDA-489 LXI-506 -837 * 0075 0002 FILEFCB EQU-77 LXI-679 -918 * 0073 0000 FILEFLAGS * 0074 0001 FILEINDEX ADI-936 * 0069 015B FILETABLE SHLD-161 LHLD-169 -210 -224 * ---- 0A4C FILLZERO CALL-179 -646 -816 * ---- 09EE FINISHOUTPUT CALL-230 * 0079 0528 FTSIZE DS-967 * 0967 1A61 FTSPACE LXI-160 * 0901 074C GETCHAR CALL-538 * 0934 076D GETCHAR2 JP-908 * 0945 077C GETCHAR3 JRNZ-942 * 0485 058D GETFILE CZ-336 * 0514 05B9 GETFILEERR JRNC-491 * 0510 05B6 GETFILEZ JMPR-518 * 0533 05C4 GETLINE CALL-277 * 0537 05CB GETLINE1 JRNZ-548 -552 JMPR-555 * 0556 05E9 GETLINEDONE JRZ-540 -545 * 0255 0436 KEYEND LXI-348 -385 * 0256 043A KEYINCLUDE LXI-323 * 0254 0430 KEYSTART LXI-292 -370 * 0569 05EF KEYWORD CALL-293 -324 -349 -371 -386 * 0576 05FB KEYWORD2 JRNZ-574 * 0086 0800 LBSIZE DS-968 * 0968 1F89 LBSPACE LXI-144 * 0076 0023 LENGTHFCB EQU-77 -78 LXI-178 -205 -645 * 0078 00A5 LENGTHFILE EQU-79 LXI-163 -503 -834 * 0061 000C LENGTHFILEREF EQU-62 -64 LXI-176 -178 -500 -642 -645 -777 * 0064 0020 LENGTHNAME EQU-65 LXI-154 -436 -610 * 0063 0013 LENGTHUNIT EQU-64 LXI-815 * 0085 0171 LINEBUFFER SHLD-145 LHLD-405 -536 -701 -871 * 0589 05FE LOOKUP CALL-305 -333 * 0602 060C LOOKUP1 DJNZ-613 * 0617 0622 LOOKUPHIT JRZ-608 * 0098 0353 MAIN * 0130 038A MAINBADDRIVE JRNC-121 JRC-123 JRNC-136 * 0117 0372 MAINDRIVE1 DJNZ-128 * 0133 0392 MAINDRIVE2 JRZ-119 * 0138 0398 MAINDRIVE3 JRNZ-111 * 0201 0405 MAINNAME JRZ-196 * 0187 03ED MAINOP1 JRNZ-185 * 0194 03F7 MAINOP2 JRNZ-192 * 0083 0010 MAXDRIVES MVI-115 CPI-135 * 0072 0008 MAXFILES EQU-79 CPI-490 * 0059 0080 MAXNAMES EQU-65 CPI-429 * ---- 07D2 MOVEHTOD CALL-177 -206 -437 -501 -778 * ---- 0818 MOVEHTODELIM CALL-819 * 0093 02FE MSGBADDRIVE ABORT-131 * 0092 02DC MSGBADSTMT LXI-754 -786 * 0095 033D MSGIGNORED LXI-855 * 0090 02A2 MSGNAMES LXI-449 * 0091 02C0 MSGNESTING LXI-515 * ---- 01C1 MSGNOFILE ABORT-197 LXI-660 * ---- 01A2 MSGNONAME ABORT-186 * 0094 031B MSGNOUNIT LXI-407 * 0057 0158 NAMECOUNT STA-153 LDA-428 LXI-440 LDA-599 * 0060 0000 NAMEFILE * 0056 0156 NAMETABLE SHLD-151 LHLD-202 -221 -597 * 0062 000C NAMEUNIT LXI-265 -465 -746 -810 * 0071 015E NEXTFILE SHLD-165 LHLD-493 -502 SHLD-505 LHLD-833 * SHLD-836 * 0058 0159 NEXTNAME SHLD-156 LHLD-433 SHLD-439 * 0065 1000 NTSIZE DS-966 * 0966 0A61 NTSPACE LXI-150 * 0969 2789 OBSPACE LXI-215 * 0271 0454 OF2 JRZ-269 * 0346 04D8 OFEND JRNZ-326 * 0321 04A5 OFINC * 0341 04D3 OFINCZ JRNZ-332 JRZ-334 JRNZ-337 * 0319 04A2 OFNOTSTART JRNZ-295 * 0368 04FB OFSEARCH * 0383 0516 OFSKIP JRZ-366 * 0397 052F OFSKIP2 JRNZ-393 * 0360 04F0 OFSORS JNZ-282 * 0290 0472 OFSTART JRNZ-286 * 0311 0498 OFSTART1 JRNZ-306 * 0313 049B OFSTART2 JRNZ-304 * 0315 049E OFSTART3 JMPR-310 * 0401 0533 ONEDONE JNZ-276 JZ-278 * 0258 0442 ONEFILE CALL-226 CZ-339 * 0409 0544 ONEFILEZ JRZ-404 * 0273 0455 ONEWHILE JMPR-288 JMP-317 -344 JNZ-351 -354 JMP-358 * JZ-363 JNZ-373 -376 JMP-381 JNZ-388 JMP-399 * 0663 0653 OPENDONE JRZ-654 * 0674 0657 OPENFCB CALL-195 -653 * 0632 0626 OPENFILE CALL-338 * 0652 063F OPENLOOP JRNZ-658 * ---- 07E1 PARSEFILEREF CALL-730 * 0800 06D7 PARSEUNIT CALL-736 -783 * 0808 06E4 PARSEUNIT2 JRNZ-804 * 0821 06F9 PARSEUNIT3 JMPR-806 * ---- 0890 PUTCHAR CALL-704 * 0698 066C PUTLINE CALL-287 -314 -320 -377 * 0702 0671 PUTLINE1 JRNZ-707 * 0753 06AB RECNAMEBAD JRZ-728 JRNZ-731 -737 * 0739 069D RECNAMEDONE JMPR-751 -757 * 0744 06A0 RECNAMENULLU JRNZ-734 * 0719 067E RECORDNAME CALL-331 * 0769 06B6 RECORDUNIT CALL-302 * 0789 06D5 RECUNITDONE JRZ-784 * 0830 06FC RELFILE CALL-340 * 0848 070F REPORTERROR CALL-408 -450 -516 -661 -755 -787 * 0250 0080 SEARCHING MVI-270 ANI-281 -365 -379 -403 * ---- 091A SETUPOUTPUT CALL-217 * 0866 0725 SHOWLINE CALL-263 -851 * 0874 072E SHOWLINE1 DJNZ-881 * 0885 0742 SHOWLINE2 JRZ-879 * 0251 0040 SKIPPING ANI-281 ORI-308 ANI-395 * ---- 07C3 SKIPWHITE CALL-469 -726 -782 * 0066 005C TEMPNAME LXI-301 -330 -391 * 0084 0023 TRIGGER CPI-547 * ---- 0881 TYPECHAR CALL-853 -877 -884 CNZ-888 * ---- 0878 TYPEMESSAGE CALL-854 -856 * ---- 07CB WHITESPACE CZ-573 * CENSUS OF OPCODE USAGE * * ABORT 3 ADI 1 ANI 6 * CALL 69 CMP 1 CNZ 1 * CPI 12 CZ 3 DAD 13 * DB 11 DCR 2 DCX 1 * DJNZ 3 DS 5 DW 5 * END 1 EQU 22 INR 5 * INX 20 JMP 5 JMPR 8 * JNZ 7 JP 1 JRC 1 * JRNC 4 JRNZ 22 JRZ 13 * JZ 2 LDA 4 LDAX 9 * LHLD 14 LXI 49 MACLIB 2 * MOV 35 MVI 16 ORA 7 * ORI 9 POP 62 PROLOG 1 * PUSH 62 RET 18 RM 1 * SERVICE 1 SHLD 8 STA 2 * STAX 11 SUI 1 XCHG 17 * XRA 7 XTHL 1