0000 TITL 1.4 SAVE COMMAND"VERSION 77.08.26 0001 * 0002 * 0003 * 0004 * SAVE COMMAND 0005 * 0006 COPY PTDEFS 0007 * 0008 DRESZ EQU 21 LENGTH OF DIRECTORY ENTRY /// SYSTEM REF /// 0009 CR EQU 0DH CARRIAGE RETURN 0010 LF EQU 0AH LINE FEED 0011 * 0012 ORG 100H 0013 XEQ 100H 0014 * 0015 LHLD SYSGLO GET GLOBAL AREA 0016 LXI D,GLCOF COFILE OFFSET FROM SYSGLO 0017 DAD D 0018 MOV A,M COFILE 0019 STA OFNUM SET AS OUTPUT FILE NUMBER 0020 * 0021 LXI D,GLUNI-GLCOF GLUNI IS DEFAULT UNIT OFFSET 0022 DAD D POINT TO DEFAULT UNIT 0023 MOV A,M 0024 ADI '0' ASCII OFFSET REQUIRED BY NAMIN 0025 STA SRUNT 0026 * 0027 * SCAN OPTIONS, UNITS, TYPES AND NAMES UNTIL END 0028 * 0029 FINAM CALL FLMCK SCAN TO CR OR ; ONLY 0030 MVI A,PSOPT READ TO DELIMITER ONLY 0031 LHLD NBPTR 0032 PUSH H 0033 XCHG 0034 CALL PSCAN 0035 STA DELMT SAVE THE DELIMITER 0036 POP H 0037 CC PSCER IF ERROR 0038 JZ FINAM IF NO CHRS 0039 * 0040 * FIND OUT WHICH BRANCH TO TAKE 0041 EQSRH MOV A,M GET READ IN CHAR 0042 CPI '=' OPTIONS TYPE? 0043 JZ OPNT1 FOUND ONE 0044 INX H NOPE SO CHECK NEXT CHAR 0045 ORA A SET FLAGS ON CHAR JUST CHECKED 0046 JNZ EQSRH KEEP LOOPING UNTIL 0 0047 * 0048 * 0049 * NAME OR UNIT COME HERE 0050 * 0051 LHLD NBPTR 0052 MOV A,M FIRST TEST IF UNIT 0053 CPI '/' 0054 JZ UNPRC IF SO THEN PROCESS 0055 * 0056 * INCREMENT THE NAME BUFFER POINTER 0057 * 0058 LXI D,13 INCREMENT IT 0059 DAD D 0060 SHLD NBPTR RE STORE IT 0061 MVI M,0 0062 LDA NBRNA 0063 INR A 0064 STA NBRNA 0065 CPI 11 HOW MANY HAVE WE PROCESSED? 0066 CNC XNAMS 0067 JMP FINAM 0068 * 0069 * SCAN OFF THE UNIT 0070 * 0071 UNPRC INX H MOVE TO THE UNIT 0072 MOV A,M GET CHR 0073 STA SRUNT SET AS DIRECTORY FOR SEARCH 0074 JMP FINAM AND LOOP UP AND OVER 0075 * 0076 * 0077 * SCAN OPTIONS 0078 * 0079 * 0080 OPNT1 LHLD NBPTR POINT TO START OF BUFFER 0081 MOV A,M GET FIRST CHR FROM BUFFER 0082 PUSH PSW SAVE FOR LATER 0083 * GOTO THE EQUALS SIGN: ALLOWS "SET= FOR S=" 0084 OPN1A ORA A 0085 CZ NOEQ NO EQUALS FOUND? 0086 CPI '=' 0087 INX H 0088 MOV A,M GET NEXT CHR 0089 JNZ OPN1A 0090 * 0091 * PROCESS THE LOT OF THEM 0092 * 0093 OPN1B POP PSW CALL MAP CONVERT TO UPPER CASE 0094 CPI 'T' TYPE? 0095 JZ TOPNT TYPE OPTION 0096 * 0097 CPI 'O' OUTPUT 0098 JZ OPSET 0099 * 0100 CPI 'S' SWITCH? 0101 CNZ BADP NOPE 0102 * 0103 LDA OPFLG GET OPTION PROCESSED FLAG 0104 ORA A 0105 CNZ BADP ALREADY PROCESSED THE OPTIONS 0106 INR A 0107 STA OPFLG 0108 JMP SOPNT 0109 * 0110 * GET THE OUTPUT FILE NAME OR UNIT 0111 * 0112 * CREATE, OPEN AS REQUIRED 0113 * 0114 OPSET LDA OTSET SEE IF OUTPUT IS ALREADY SET 0115 ORA A 0116 CNZ BADP 0117 INR A 0118 STA OTSET 0119 * 0120 MOV A,M GET FIRST CHR FROM BUFFER 0121 CPI '/' STAND ALONE UNIT? 0122 CZ BADP 0123 LXI D,FBUF TEMP BUFFER FOR PSCAN (WITH CREATE HEADER) 0124 MVI A,PSCO+40H OPEN FILE NAME, CREATE IF NECESSARY 0125 CALL PSCAN 0126 CC PSCER 0127 MOV A,D 0128 ORA A 0129 CNZ FBIG FILE NUMBER TOO BIG 0130 MOV A,E 0131 CPI 0FFH 0132 JZ ILFNM 0133 STA OTNUM SAVE AS OUTPUT FILE NUMBER 0134 JMP FINAM 0135 * 0136 * 0137 * PROCESS SET FLAGS (L,H,I) 0138 * 0139 SOPNT MVI B,0 POSSIBLE FLAG STATUS (NOT SET) 0140 GETCH MOV A,M CALL MAP CONVERT TO UPPER CASE 0141 INX H 0142 ORA A 0143 JZ FINAM 0144 CPI '-' 0145 JNZ LFLAG 0146 MVI B,1 NEXT FLAG WILL BE SET 0147 JMP GETCH 0148 * 0149 LFLAG CPI 'L' LIST SAVED FILES FLAG 0150 JNZ HFLAG 0151 MOV A,B 0152 STA LISTF 0153 JMP SOPNT 0154 * 0155 HFLAG CPI 'H' SUPPRESS HEADING FLAG 0156 JNZ IFLAG 0157 MOV A,B 0158 STA HEADF 0159 JMP SOPNT 0160 * 0161 IFLAG CPI 'I' INFO PROTECT FLAG 0162 CNZ ILLOP 0163 MOV A,B 0164 STA IPRTF 0165 JMP SOPNT 0166 * 0167 * 0168 * PROCESS THE TYPE OPTION 0169 * 0170 TOPNT LDA TYPPR GET THE TYPE OPTION SET FLAG 0171 ORA A 0172 CNZ BADP ALREADY DID IT 0173 MOV A,M GET DESIRED TYPE 0174 CPI 'I' POSSIBLE IMAGE TYPE? 0175 JNZ DFILE 0176 MVI A,-1 SET IMAGE FLAG 0177 STA IMAGF 0178 INX H GET NEXT CHAR 0179 MOV A,M 0180 ORA A IF IS 0 THEN TYPE IS 'I' 0181 JNZ NORM 0182 MVI A,' ' TYPE I IS ASCII BLANK 0183 JMP NORM 0184 DFILE CPI 'D' DEVICE FILE? 0185 JNZ NORM STANDARD TYPE 0186 MVI A,-1 SET DEVICE TYPE 0187 * 0188 NORM CPI '#' CHECK FOR NUMBER INPUT 0189 JNZ ITEST 0190 MVI A,PSV+40H USE PSCAN TO CONVERT NUMBER 0191 INX H MOVE TO NUMBER 0192 LXI D,FBUF SCRATCH BUFFER FOR PSCAN 0193 CALL PSCAN CONVERT 0194 CC NUMER 0195 JZ TYNUM IF NO NUMBER AFTER # THEN... 0196 MOV A,D CHECK THAT NUMBER < 256 0197 ORA A 0198 JNZ NUMER HIGH BYTE MUST BE 0 0199 MOV A,E 0200 JMP ITEST 0201 TYNUM MVI A,'#' REALLY TYPE # 0202 ITEST MOV C,A SAVE TYPE 0203 LDA IMAGF CHECK IF IMAGE 0204 ORA A 0205 MOV A,C GET TYPE BACK 0206 JNZ SETY1 IF SET LEAVE HIGH BIT CLEAR 0207 SETY ORI 80H 0208 SETY1 STA FTYPE SET THE TYPE IN 0209 MVI A,-1 0210 STA TYPPR SET TYPE OPTION 0211 JMP FINAM AND GO BACK 0212 * 0213 * 0214 * 0215 FLMCK LDA DELMT 0216 CPI ';' 0217 JZ FSAVE 0218 CPI 0DH 0219 RNZ 0220 * 0221 * 0222 * RESTORE AND SET UP INIT PARAMS 0223 * 0224 FSAVE EQU $ 0225 HDMSG LHLD NBPTR 0226 MVI M,0 BE SURE THE LAST NAME IS NOT HERE 0227 LDA OTSET CHECK IF OUTPUT FILE WAS SPECIFIED 0228 ORA A 0229 JZ OPEXP IF NOT THEN ERROR 0230 LXI H,NABUF 0231 SHLD NBPTR SET THE NAME BUFFER POINTER 0232 * 0233 * 0234 * OPEN "DIRECTRY" AND READ IT TO THE BUFFER 0235 * 0236 LXI D,DMSG POINTER TO ASCII "DIRECTRY" 0237 CALL FOPEN OPEN THE DIRECTRY 0238 STA FILEN 0239 * 0240 * READ IN THE DIRECTORY INFORMATION 0241 * 0242 LXI D,DABUF THE DIRECTORY BUFFER 0243 LXI B,256*16 JUST EXACTLY ENOUGH 0244 CALL SYS FILE # IN A FROM FOPEN 0245 DB RBLOP READ BLOCK 0246 CALL DIRER CLOSE THE DIRECTORY BEFORE RETURN 0247 * 0248 * NOW CLOSE IT 0249 * 0250 CALL FCLOS NOW CLOSE DIRECTRY FILE (# STILL IN A) 0251 * 0252 * GET AND STORE DATE 0253 * 0254 LHLD SYSGLO GET ADDR OF SYSTEM GLOBAL AREA 0255 LXI B,GLDAT ADD IN OFFSET TO DATE 0256 DAD B 0257 LXI D,DATE WHERE DATE GOES 0258 MVI C,3 TRANSFER 3 BYTES 0259 DATEL MOV A,M GET 0260 STAX D STORE 0261 INX H MOVE 0262 INX D 0263 DCR C 0264 JNZ DATEL 0265 * 0266 * OUTPUT HEADER MESSAGE 0267 * 0268 HEADR CALL CRLF 0269 LDA HEADF SEE IF SUPPRESS HEADER 0270 ORA A 0271 JNZ SLOOP SKIP IF NON ZERO 0272 LDA LISTF IF WE ARE NOT LISTING FILES, WE DON'T NEED 0273 ORA A THE HEADING EITHER 0274 JNZ SLOOP 0275 * 0276 LXI H,HMSG HEADER MESSAGE BUFFER ADDRESS 0277 MVI E,1 0278 CALL SPAC2 0279 CALL CRLF 0280 LXI H,HMSG1 0281 MVI E,4 0282 CALL SPAC2 0283 CALL CRLF * 0284 * NOW MAKE IT PRETTY * 0285 MVI E,64 * 0286 FMLOP DCR E 0287 JZ HDR2 0288 MOV A,E 0289 RRC 0290 MVI B,'-' 0291 JNC FMOUT 0292 MVI B,'+' 0293 FMOUT CALL WRITB 0294 JMP FMLOP 0295 HDR2 CALL CRLF 0296 * 0297 * 0298 * 0299 * LOOP HERE FOR EACH NAME PROCESSED 0300 * 0301 SLOOP LXI H,DABUF RESET THE DIRECTORY BUFFER POINTER 0302 SHLD DRPTR 0303 * 0304 * GET NEXT NAME INTO THE NAME BUFFER 0305 * 0306 NAMIN LHLD NBPTR GET NAME BUFFER POINTER 0307 MOV A,M 0308 ORA A 0309 STA FNAM1 BE SURE ITS ZERO FOR PASS NAME 0310 JZ ENTR SKIP THE NAME 0311 XRA A 0312 STA LTSYM 0313 STA GTSYM 0314 LXI D,FNAM1 FILE NAME GOES HERE 0315 * 0316 * MOVE IN THE NAME 0317 * 0318 MVI C,8 0319 PRCS0 MOV A,M 0320 CPI '/' SOWHAT IF THEY GOOFED 0321 JZ PRCAB 0322 ORA A ALL DONE? 0323 JZ PRCAB 0324 INX H 0325 * VALID CHR OR PROCESS SYMBOL 0326 CPI '>' 0327 JZ PRC1A 0328 CPI '<' 0329 JZ PRC1B CALL MAP CONVERT TO UPPER CASE 0330 STAX D 0331 INX D 0332 DCR C 0333 JMP PRCS0 0334 * 0335 PRC1A STA GTSYM 0336 JMP PRCS0 0337 * 0338 PRC1B STA LTSYM 0339 JMP PRCS0 0340 * 0341 * 0342 PRCAB XCHG . BE SURE TO TERMINATE WITH ZERO 0343 MVI M,0 0344 MOV A,C CALCULATE LENGTH OF NAME 0345 SUI 8 0346 CMA 0347 INR A 0348 STA NALNG 0349 * 0350 * GET NUMBER OF ENTRIES 0351 * 0352 ENTR LHLD DRPTR GET DIRECTORY ENTRY POINTER 0353 MOV A,M GET NUMBER OF ENTRIES 0354 INX H 0355 INX H POINT TO FIRST ENTRY 0356 SHLD ENPNT SAVE ENTRY POINTER 0357 LXI B,256-2 0358 DAD B 0359 SHLD DRPTR 0360 INR A FUDGE COUNT 0361 STA ECOUNT SAVE COUNT 0362 * 0363 * READ ENTRY 0364 * 0365 ENTR2 CALL INTST 0366 LDA ECOUNT GET COUNT 0367 DCR A ANY? 0368 STA ECOUNT 0369 JNZ ENTR3 YES, CONT 0370 LHLD DRPTR GET DIRECTORY POINTER 0371 * SEE IF WE PASSED THE END 0372 INX H 0373 MOV A,H 0374 CPI DIEND 0378 JC ENTR 0379 JMP EOF 0380 * 0381 * 0382 ENTR3 CALL READ GET NEXT ENTRY TO BUFFER 0383 LHLD ENPNT CHECK IF ENTRY HAS ALREADY BEEN USED 0384 MOV A,M GET 1ST LETTER OF NAME 0385 ORA A TEST FOR ZERO 0386 JZ NXTEN IF SO SKIP THIS ENTRY 0387 CALL PRINT GO SEE IF SAVE THIS ONE 0388 NXTEN LHLD ENPNT 0389 LXI D,DRESZ UPDATE ENTRY POINTER 0390 DAD D 0391 SHLD ENPNT 0392 JMP ENTR2 0393 * 0394 * 0395 * READ BLOCK 0396 * 0397 READ LHLD ENPNT GET ENTRY BUFFER 0398 LXI D,BUFR AND MOVE IT TO BUFR 0399 MVI C,DRESZ 0400 * 0401 READ1 MOV A,M 0402 STAX D 0403 INX H 0404 INX D 0405 DCR C 0406 JNZ READ1 0407 RET 0408 * 0409 * 0410 * END OF FILE 0411 * 0412 EOF LHLD NBPTR 0413 MOV A,M 0414 ORA A 0415 JZ EOF2 0416 LXI D,13 0417 DAD D 0418 SHLD NBPTR 0419 MOV A,M 0420 ORA A 0421 JZ EOF2 0422 JMP SLOOP KEEP LOOPING UNTIL ZERO 0423 * 0424 * MESSAGES CODE GOES HERE 0425 EOF2 EQU $ 0426 * 0427 * OUTPUT DATE OR NO SAVE MESSAGE 0428 * 0429 CALL CRLF 0430 LDA SAVEF CHECK IF ANY FILES WERE SAVED 0431 ORA A 0432 JZ NONE NOPE SO SAY SO 0433 * 0434 LDA DATE GET MONTH 0435 MOV B,A 0436 CALL HEX2A CONVERT TO ASCII 0437 MOV H,E 0438 MOV L,D 0439 SHLD MONTH PUT INTO MESSAGE 0440 * 0441 LDA DATE+1 GET DAY 0442 MOV B,A 0443 CALL HEX2A ASCII-IZE 0444 MOV H,E 0445 MOV L,D 0446 SHLD DAY INTO MESSAGE 0447 * 0448 LDA DATE+2 GET YEAR 0449 MOV B,A 0450 CALL HEX2A ASCII-IZE 0451 MOV H,E 0452 MOV L,D 0453 SHLD YEAR INTO MESSAGE 0454 * 0455 LDA OFNUM OUTPUT MESSAGE 0456 LXI B,0FFFFH MAX TRANSFER COUNT 0457 LXI D,DATMS POINTER TO MESSAGE 0458 MVI L,0 MESSAGE DELIMETER 0459 CALL SYS WRITE IT 0460 DB DWROP 0461 CALL PTDER 0462 JMP ENDLN 0463 * 0464 NONE LDA OFNUM OUTPUT NO FILES SAVED MESSAGE 0465 LXI B,0FFFFH MAX TRANSFER COUNT 0466 LXI D,NOSAV POINTER TO MESSAGE 0467 MVI L,0 DELIMETER 0468 CALL SYS 0469 DB DWROP 0470 CALL PTDER 0471 * 0472 ENDLN CALL CRLF 0473 * 0474 * EOF AND CLOSE OUTPUT FILE 0475 * 0476 LDA OTNUM FILE # 0477 CALL SYS 0478 DB EOFOP 0479 CALL PTDER 0480 CALL FCLOS 0481 * 0482 ENDF CALL SYS 0483 DB RETOP 0484 * 0485 * 0486 * 0487 * ERROR HANDLING 0488 * 0489 DIRER PUSH PSW SAVE THE ERROR NUMBER 0490 LDA FILEN 0491 CALL SYS 0492 DB CLOOP 0493 NOP . IGNORE AN ERROR. 1ST ERROR MORE IMPORTANT 0494 NOP 0495 NOP 0496 POP PSW GET BACK ERROR AND ABORT 0497 JMP PTDER 0498 * 0499 PSCER MOV A,E PSCAN ERROR 0500 ORA A TEST IF PTDOS OR FIELD 0501 JNZ GENER PTDOS 0502 LXI H,FLDER 0503 JMP ERMES 0504 FLDER ASC 'FIELD ERROR' 0505 DB 0 0506 * 0507 GENER STA ERMCD ERROR # 0508 POP H GET RETURN ADDRESS 0509 DCX H MOVE BACK TO CALL 0510 DCX H 0511 DCX H 0512 DCX H 0513 DCX H 0514 DCX H 0515 MVI A,03H PRINT 'CALLED FROM' 0516 JMP ERROR 0517 * 0518 PTDER STA ERMCD STANDARD PTDOS ERROR 0519 POP H GET RETRUN ADDRESS 0520 DCX H MOVE BACK TO COMMAND OP 0521 DCX H 0522 DCX H 0523 DCX H 0524 MOV A,M STORE FOR ERROR HANDLER 0525 STA COMCD 0526 DCX H MOVE BACK TO ACTUAL CALL 0527 DCX H 0528 DCX H 0529 MVI A,03H SET FLAG ARG TO PRINT 'CALLED FROM' 0530 JMP ERROR 0531 * 0532 XNAMS LXI H,TOMNY 0533 JMP ERMES 0534 TOMNY ASC 'TOO MANY NAMES' 0535 DB 0 0536 * 0537 NOEQ LXI H,NOEQM 0538 JMP ERMES 0539 NOEQM ASC 'NO EQUALS SIGN IN OPTION PARAMETER' 0540 DB 0 0541 * 0542 BADP LXI H,BADPM 0543 JMP ERMES 0544 BADPM ASC 'BAD OPTION PARAMETER' 0545 DB 0 0546 * 0547 FBIG LXI H,FBIGM 0548 JMP ERMES 0549 FBIGM ASC 'FILE NUMBER TOO BIG' 0550 DB 0 0551 * 0552 OPEXP MVI A,EROPX OPTIONAL PARAMETER EXPECTED 0553 JMP ERCOD 0554 * 0555 ILFNM MVI A,ERIFI ILLEGAL FILE NAME 0556 JMP ERCOD 0557 * 0558 NUMER MVI A,ERIVA ILLEGAL VALUE 0559 JMP ERCOD 0560 * 0561 ILLOP MVI A,ERIOS ILLEGAL OPTION SPECIFIER 0562 JMP ERCOD 0563 * 0564 * 0565 ERMES MVI A,00H ERROR MESSAGE ONLY 0566 JMP ERROR 0567 * 0568 ERCOD STA ERMCD ERROR CODE ONLY 0569 XRA A 0570 * 0571 ERROR PUSH PSW SAVE FLAG ARG 0572 LDA OTNUM CHECK FOR POSSIBLE OUTPUT FILE OPEN 0573 CPI 0FFH 0574 JZ APOP NO OUTPUT FILE 0575 CALL SYS TRY TO CLOSE IT 0576 DB CLOOP 0577 NOP . IGNORE ERROR. 1ST ERROR MORE IMPORTANT 0578 NOP 0579 NOP 0580 APOP POP PSW GET FLAG ARG BACK 0581 CALL UTIL ERROR HANDLER 0582 DB UXOP 0583 JMP ABORT ERROR RETURN 0584 COMCD DB -1 COMMAND CODE 0585 ERMCD DB -1 ERROR # 0586 ABORT CALL SYS 0587 DB ABTOP 0588 * 0589 * 0590 * COMPARE AND SAVE 0591 * 0592 PRINT LDA TYPPR 0593 ORA A 0594 JZ INFTS PRINT ALL TYPES 0595 LDA FTYPE GET DESIRED TYPE 0596 LXI H,BUFR+8 GET TYPE 0597 CMP M CHECK IF TYPE IS THE ONE WE WANT 0598 RNZ . NO, GET NEXT FILE 0599 * 0600 INFTS LDA IPRTF CHECK INFO PROTECT OPTION 0601 ORA A 0602 JNZ PRNIT IF FLAG SET SAVE EVERYTHING 0603 LDA BUFR+11 GET ATTRIBUTES 0604 ANI 08H MASK OFF ALL BUT INFO PROTECT 0605 RNZ . IF SET DON'T SAVE THIS FILE 0606 * 0607 * CODE TO SEARCH FOR NAME 0608 * 0609 PRNIT LHLD NBPTR SEARCH FOR NAME 0610 MOV A,M 0611 ORA A 0612 JZ PRIN2 0613 * 0614 * SEARCH FOR THIS NAME 0615 * 0616 MVI A,8 LETTERS LEFT TO TEST IN ENTRY NAME 0617 STA ENLNG 0618 LXI H,BUFR-1 BEGINNING OF ENTRY NAME (FUDGED) 0619 SHLD LPTR STORE FOR NEXT TIME AROUND 0620 * 0621 NLOOP LXI D,FNAM1 NAME TO COMPARE TO ENTRY 0622 LDA NALNG GET LENGTH OF THIS NAME 0623 INR A FUDGE IT 0624 MOV C,A STAYS IN C 0625 LDA ENLNG CURRENT LENGTH OF ENTRY NAME 0626 INR A FUDGE IT 0627 MOV B,A STAYS IN B 0628 * 0629 N2LOP INX H NEXT LETTER IN ENTRY NAME 0630 MOV A,M CHECK IF NAME IS DONE 0631 ORA A CHECK FOR ZERO BYTE 0632 JZ ENEND 0633 DCR B CHECK FOR MAX LENGTH OF ENTRY NAME REACHED 0634 JZ ENEND 0635 DCR C CHECK FOR END OF INPUT NAME 0636 JZ INEND 0637 * 0638 LDAX D COMPARE THE 2 CURRENT CHARS 0639 INX D PUSH B MOV B,A SAVE THE CHARACTER MOV A,M GET THE CHARACTER CALL MAP CONVERT TO UPPER CASE CMP B CHECK THE CHARACTER POP B 0641 JZ N2LOP IF = KEEP CHECKING 0642 JMP NOMAT OTHERWISE NO MATCH THIS ROUND 0643 ENEND DCR C CHECK IF BOTH NAMES ENDED TOGETHER 0644 JZ MATCH IF SO, BINGO! 0645 JMP NOMAT OTHERWISE ZONK THIS ROUND 0646 INEND LDA GTSYM CHECK IF OK IF INPUT ENDED 1ST 0647 ORA A 0648 JNZ MATCH IF > INPUT THEN YIPPEE 0649 * 0650 * NAMES DIDN'T MATCH THIS ROUND 0651 * SEE IF WE GO FOR ANOTHER 0652 * 0653 NOMAT LDA LTSYM CHECK IF NAME BEGINNINGS MUST MATCH 0654 ORA A 0655 RZ . IF SO THEN THESE NAMES DON'T 0656 LDA ENLNG CHECK IF WE REACHED END OF ENTRY NAME 0657 DCR A 0658 RZ . IF SO THEN WE DIDN'T MATCH 0659 STA ENLNG STORE NEW LENGTH 0660 LHLD LPTR SET NEW ENTRY NAME POINTER 0661 INX H 0662 SHLD LPTR 0663 JMP NLOOP 0664 * 0665 * 0666 MATCH EQU $ 0667 PRIN2 EQU $ 0668 LDA LISTF CHECK IF WE LIST FILES SAVED 0669 ORA A 0670 JNZ OPN IF FLAG SET SKIP PRINT 0671 * 0672 * PRINT FILE INFO 0673 * 0674 MVI C,63 INITIALIZE OUTPUT BUFFER TO BLANKS 0675 LXI H,OBUFF 0676 BLOOP MVI M,' ' 0677 INX H 0678 DCR C 0679 JNZ BLOOP 0680 * 0681 LXI D,OBUFF+1 WHERE NAME GOES 0682 LXI H,BUFR WHERE NAME IS 0683 MVI C,8 CHAR COUNT 0684 NMLOP MOV A,M GET A CHAR 0685 ORA A TEST IF IT'S ZERO 0686 JZ TYPE IF SO THEN NEXT FIELD 0687 STAX D STORE CHAR IN OUTPUT BUFFER 0688 INX H 0689 INX D 0690 DCR C 0691 JNZ NMLOP IF 8 CHARS OUT THEN NAME MUST BE DONE 0692 * 0693 * TYPE 0694 * 0695 TYPE LXI H,OBUFF+15 WHERE TYPE GOES 0696 LDA BUFR+8 WHERE TYPE IS 0697 ORA A CHECK IF IMAGE 0698 JP IMG IF HIGH BIT CLEAR THEN IMAGE 0699 CPI -1 CHECK IF DEVICE FILE 0700 JZ DEVF 0701 ANI 7FH CLEAR HIGH BIT 0702 TYPIN CPI 5FH CHECK FOR AN UNDER LINE (SPACES BACKWARD) 0703 JZ NOPR 0704 CPI 20H CHECK FOR A NONPRINTING CHAR (ASCII < BLANK) 0705 JC NOPR 0706 MOV M,A 0707 JMP BLCKS 0708 * 0709 IMG MVI M,'I' PRINT 'I' 1ST 0710 INX H 0711 JMP TYPIN 0712 DEVF MVI M,'D' DEVICE FILE 0713 JMP BLCKS 0714 * 0715 NOPR MOV B,A CONVERT CHAR TO 2 ASCII DIGITS 0716 CALL HEX2A 0717 MOV M,D STORE 2 DIGITS IN OUTPUT BUFFER 0718 INX H 0719 MOV M,E 0720 * 0721 * BLOCK SIZE 0722 * 0723 BLCKS LHLD BUFR+9 BLOCK SIZE INTO HL 0724 MOV B,H CONVERT HIGH BYTE TO ASCII IN DE 0725 CALL HEX2A 0726 LXI B,OBUFF+27 WHERE SIZE GOES 0727 MOV A,D PUT 1ST DIGIT IN 0728 STAX B 0729 INX B 0730 MOV A,E 2ND DIGIT 0731 STAX B 0732 INX B 0733 PUSH B SAVE ADDR FOR NEXT 2 DIGITS 0734 MOV B,L CONVERT LOW BYTE TO ASCII 0735 CALL HEX2A 0736 POP B GET BACK ADDR TO PUT CHARS AT 0737 MOV A,D PLACE 3RD DIGIT 0738 STAX B 0739 INX B 0740 MOV A,E PLACE 4TH DIGIT 0741 STAX B 0742 * 0743 * ATTRIBUTES 0744 * 0745 MVI C,8 ATTRIBUTE COUNT FOR ROTATE 0746 LXI H,OBUFF+44 WHERE ATTRIBUTES GO 0747 LXI D,ATTRS ATTRIBUTE STRING 0748 LDA BUFR+11 GET ATTRIBUTES 0749 MOV B,A PLACE THEM IN B 0000 * 0750 ALOOP MOV A,B GET ATTRIBS 0751 RRC . CHECK IF CURRENT ATTRIBUTE IS SET 0752 MOV B,A REPLACE ROTATED ATTRIBUTES 0753 JNC NEXT IF BIT 0 THEN NO ATTRIBUTE 0754 LDAX D GET ATTRIBUTE CHAR 0755 MOV M,A PUT IN OUTPUT BUFFER 0756 INX H 0000 * 0757 NEXT INX D GO TO NEXT ATTRIBUTE CHAR 0758 DCR C ATTRIBUTE COUNT 0759 JNZ ALOOP LOOP UNTIL ALL 8 TESTED 0760 * 0761 * OUTPUT LINE NOW 0762 * 0763 LDA OFNUM CONSOLE OUTPUT NUMBER 0764 LXI B,63 # OF CHARS IN OUTPUT BUFFER TO WRITE 0765 LXI D,OBUFF POINTER TO BUFFER 0766 CALL SYS WRITE DIRECTORY LINE 0767 DB WBLOP 0768 CALL PTDER 0769 CALL CRLF 0770 * 0771 * OPEN INPUT FILE 0772 * 0773 OPN EQU $ 0774 MVI C,8 FIND END OF NAME IN ENTRY TO ADD UNIT 0775 LHLD ENPNT GET BEGINNING OF NAME 0776 XRA A CLEAR A 0000 * 0777 OLOOP CMP M SEE IF ZERO BYTE ENDS NAME 0778 JZ PUTUN 0779 INX H 0780 DCR C 0781 JNZ OLOOP IF C=0 NAME IS DONE 0000 * 0782 PUTUN MVI M,'/' ADD UNIT AFTER NAME 0783 INX H 0784 LDA SRUNT GET UNIT # 0785 MOV M,A PUT INTO NAME 0786 INX H 0787 MVI M,0 TERMINATE WITH 0 0788 * 0789 LHLD ENPNT GET ADDRESS OF NAME * * SEE IF THIS IS A DEVICE FILE, IS SO THEN * CHECK FOR TYPE/NAME ATTRIBUTE. IF THE FILE * FILE DOESN'T HAVE 'N' ATTRIBUTE, CHANGE THE * FILE TYPE, OTHERWISE MUST CHANGE ATTRIBUTES * FIRST (UNLESS IT IS A TYPE/NAME AND ATTRIBUTE * PROTECTED FILE). * LDA BUFR+8 GET THE FILE TYPE CPI -1 DEVICE FILE? JNZ NOTDV NOT LDA BUFR+11 ATTRIBUTES ANI PNAT TYPE/NAME PROTECTED? JZ CHTYP NO, JUST CHANGE THE TYPE LDA BUFR+11 ANI PATR TYPE/NAME + ATTRIBUTE PROTECTED? JZ CHATR NO, CHANGE ATTRIBUTES FIRST * * FILE IS BOTH TYPE/NAME AND ATRIBUTE PROTECTED * CANNOT SAVE IT. * LHLD ENPNT POINT TO FILENAME MVI M,0 SO IT WON'T BE USED AGAIN MVI E,1 LXI H,DEVMS CALL SPAC2 RET * * MUST CHANGE THE FILE ATTRIBUTES * CHATR LHLD ENPNT FILENAME POINTER XCHG MVI H,0 NO ATTRIBUTES CALL SYS DB CHAOP CHANGE THE ATTRIBUTES CALL PTDER * * MUST CHANGE THE FILE TYPE * CHTYP LHLD ENPNT XCHG MVI H,0 TYPE 0 CALL SYS DB CHTOP CALL PTDER * NOTDV LHLD ENPNT POINTER TO FILENAME 0790 XCHG . INTO DE FOR OPEN 0791 CALL FOPEN 0792 STA IFNUM SAVE FILE # 0793 * 0794 * 0795 LHLD ENPNT BLANK THIS ENTRY 0797 * 0798 * WRITE HEADER ONTO OUTPUT FILE 0799 * 0800 LDA OTNUM LIBRARY FILE # 0801 LXI B,12 1ST WRITE NAME,TYPE,BLOCKSIZE,ATTRIBUTES 0802 LXI D,BUFR TAKE DIRECTLY FROM COPY OF ENTRY 0803 CALL SYS 0804 DB WBLOP 0805 CALL PTDER 0806 * 0807 * WRITE 1 BYTE OF FF FOR POSSIBLE FUTURE USE 0808 * 0809 MVI B,0FFH DATA TO WRITE 0810 LDA OTNUM LIBRARY FILE # 0811 CALL WB WRITE IT 0812 CALL GENER 0813 * 0814 * WRITE FLAG WORD 0815 * 0816 LHLD BUFR+14 GET RANDOM INDEX BYTES 0817 MOV A,H CHECK FOR ZERO 0818 ORA L 0819 JZ FLGWR IF 0 THEN NOT RANDOM 0820 LDA HDFLG GET CURRENT VALUE OF FLAG WORD 0821 ORI 80H SET HIGH BIT TO INDICATE RANDOM FILE 0822 STA HDFLG 0823 FLGWR LDA HDFLG GET FLAG WORD FOR WRITE 0824 MOV B,A MOVE FOR WB 0825 LDA OTNUM LIBRARY FILE # 0826 CALL WB WRITE IT 0827 CALL GENER 0828 * 0829 * NOW WRITE DATE 0830 * 0831 LXI D,DATE 0832 LXI B,3 3 BYTES LONG 0833 CALL SYS 0834 DB WBLOP 0835 CALL PTDER 0836 * 0837 * COPY INPUT FILE TO OUTPUT 0838 * 0839 LHLD BLKSZ GET BLOCK SIZE 0840 SHLD CBUFF-2 AND ADD TO BEGINNING OF COPY BUFFER 0841 WLOOP LXI D,CBUFF WHERE DATA GETS READ INTO 0842 MOV B,H BLOCK SIZE INTO BC FOR TRANSFER COUNT 0843 MOV C,L 0844 LDA IFNUM INPUT FILE # 0845 CALL SYS READ 0846 DB RBLOP 0847 CALL EOFTS EXIT FROM COPY LOOP ON EOF 0848 * 0849 LXI D,CBUFF-2 ADDRESS TO WRITE FROM. INCLUDES BLOCK SIZE 0850 MOV B,H PUT BLOCK SIZE INTO BC 0851 MOV C,L 0852 INX B +2 FOR BLOCK SIZE AT START 0853 INX B 0854 LDA OTNUM OUPUT FILE # 0855 CALL SYS WRITE 0856 DB WBLOP 0857 CALL PTDER 0858 JMP WLOOP LOOP UNTIL EOF ON READ 0859 * 0860 EOFTS CPI EREOF CHECK IF ERROR WAS EOF 0861 JNZ PTDER IF NOT THEN ERROR 0862 MOV A,L SUBTACT BC FROM BLOCK SIZE TO GET BYTES READ 0863 SUB C LOW BYTE 0864 MOV C,A 0865 STA CBUFF-2 PLACE IN BLOCK HEADER 0866 MOV A,H 0867 SBB B 0868 MOV B,A 0869 ORI 80H MAKE HIGH BIT 1 TO INDICATE LAST BLOCK 0870 STA CBUFF-1 BLOCK HEADER 0871 INX B ADD 2 FOR WRITE INCLUDING BLOCK SIZE 0872 INX B 0873 POP D GET RID OF RETURN ADDRESS 0874 LXI D,CBUFF-2 ADDRESS TO WRITE FROM 0875 LDA OTNUM OUTPUT FILE # 0876 CALL SYS WRITE OUT LAST BLOCK 0877 DB WBLOP 0878 CALL PTDER 0879 * 0880 LDA IFNUM CLOSE INPUT FILE 0881 CALL FCLOS 0882 * 0883 * 0884 * 0885 MVI A,-1 0886 STA SAVEF INDICATE THAT A FILE WAS SAVED * * CHECK IF THE FILE WAS A DEVICE FILE AND IF SO * THEN THE ORIGINAL ATTRIBUTES AND FILE TYPE * MUST BE RESTORED TO IT * LDA BUFR+8 TYPE CPI -1 DEVICE FILE? RNZ . NO LHLD ENPNT FILENAME XCHG PUSH D SAVE IT MVI H,-1 CALL SYS DB CHTOP SET TO DEVICE FILE CALL PTDER POP D LDA BUFR+11 ATTRIBUTES MOV H,A CALL SYS DB CHAOP RESET THE ATTRIBUTES CALL PTDER LHLD ENPNT MVI M,0 SO IT WON'T BE USED AGAIN 0887 RET 0888 * 0889 * 0890 * SPAC2 0891 * 0892 SPAC2 INR E FUDGE E FOR 1ST DCR 0893 LOOP DCR E THIS IS THE WORD LOOP 0894 RZ . ALL DONE WHEN E IS 0 0895 MOV D,M GET SPACE COUNT 0896 INX H 0897 CALL TAB PRINT SPACES 0898 MOV C,M GET LETTER COUNT 0899 INX H 0900 MVI B,0 0 HIGH BYTE OF TRANSFER COUNT 0901 XCHG . ADDR OF WORD INTO DE 0902 LDA OFNUM OUTPUT FILE # 0903 CALL SYS WRITE WORD 0904 DB WBLOP 0905 CALL PTDER 0906 XCHG . ADDR OF NEXT COUNT/WORD BACK TO HL 0907 JMP LOOP NEXT WORD 0908 * 0909 * TAB 0910 * 0911 TAB MOV A,D CHECK IF COUNT IS 0 0912 ORA A SET FLAGS 0913 RZ . IF SO THEN WE ARE DONE 0914 MVI B,' ' OUTPUT BLANK 0915 CALL WRITB 0916 DCR D DECREMENT BLANK COUNT 0917 JMP TAB 0918 * 0919 * 0920 * 0921 * CRLF 0922 * 0923 CRLF MVI B,CR 1ST PRINT CARRIAGE RETURN 0924 CALL WRITB 0925 MVI B,LF THEN LINE FEED 0926 CALL WRITB 0927 RET 0928 * 0929 * 0930 * 0931 * WRITB 0932 * 0933 WRITB PUSH PSW SAVE ALL REGISTERS 0934 PUSH B 0935 PUSH D 0936 PUSH H 0937 LDA OFNUM GET OUTPUT FILE # 0938 CALL WB PRINT CHAR IN B 0939 CALL GENER 0940 POP H RESTORE REGISTERS 0941 POP D 0942 POP B 0943 POP PSW 0944 RET 0945 * 0946 * 0947 * 0948 * FOPEN 0949 * 0950 FOPEN LXI H,0 STATIC BUFFERING 0951 CALL SYS OPEN FILE 0952 DB OPEOP 0953 CALL PTDER 0954 RET 0955 * 0956 * 0957 * FCLOS 0958 * 0959 FCLOS CALL SYS CLOSE FILE 0960 DB CLOOP 0961 CALL PTDER 0962 RET 0963 * 0964 * 0965 * HEX2A 0966 * 0967 HEX2A MVI A,0F0H HIGH DIGIT MASK 0968 ANA B 0969 RRC . PUT DIGIT IN LOW BYTE 0970 RRC 0971 RRC 0972 RRC 0973 CALL ASCII 0974 MOV D,A 0975 MVI A,0FH LOW DIGIT MASK 0976 ANA B 0977 CALL ASCII 0978 MOV E,A DIGITS NOW IN DE 0979 RET 0980 * 0000 * 0981 ASCII CPI 0AH SEE IF DIGIT IS TO LETTER OR NUMBER 0982 JNC LTTR 0983 ORI 30H MAKE NUMBER DIGIT ASCII 0984 RET 0000 * 0000 * 0985 LTTR SBI 9 DIGIT INTO ASCII LETTER 0986 ORI 40H 0987 RET 0988 * 0989 * 0990 * INTST 0991 * 0992 INTST CALL CONTST 0993 RZ . IF NO CHAR THEN RETURN 0994 CALL CONIN GET KEY PRESSED 0995 ORA A TEST FOR 0 (QUIT) 0996 JZ EOF2 FINISH UP 0997 LHLD SYSGLO OTHERWISE PUT CHAR BACK 0998 LXI D,GLFLG 0999 DAD D 1000 MOV M,A WE KNOW CHAR IS NON-ZERO 1001 RET . CONTINUE NORMALLY 0000 * 0000 * Map lower case letters into upper case. Letter comes in 0000 * A and leaves in A. Only A and flags are affected. 0000 * 0000 MAP CPI 'a' 'a'<=A ? 0000 RM . Nope. No map necessary. 0000 CPI 'z'+1 A<='z' ? 0000 RP . Nope. No map necessary. 0000 SUI 32 'a'=>'A', etc. 0000 RET 1002 * 1003 * 1004 * HEADER 1005 * 1006 HMSG DB 22 1007 DB 19 1008 ASC "+-+ SAVE FILES +-+" 1009 * 1010 HMSG1 DW 0403H 1011 ASC "NAME" 1012 DW 0407H 1013 ASC "TYPE" 1014 DW 0A06H 1015 ASC "BLOCK SIZE" 1016 DW 0A09H 1017 ASC "ATTRIBUTES" * DEVMS DB 5 DB DEVM1-$-1 ASC *Cannot SAVE a TYPE/ATTRIBUTE* ASC / protected device file/ DB CR DEVM1 EQU $ 1018 * 1019 ATTRS ASC 'KWRIANEU' ATTRIBUTE CHARS FOR OUTPUT 1020 * 1021 * DIRECTRY FILE NAME 1022 * 1023 DMSG ASC "DIRECTRY" DIRECTRY FILE NAME 1024 SLASH DB '/' 1025 SRUNT DB 0 REMEMBER TO GET DEFAULT UNIT HERE 1026 DB 0 END OF NAME 1027 SGLOB ASC "SYSGLOBL/" FILE TO GET DATE FROM 1028 SYSUN DW 0 SPACE FOR UNIT # 1029 DB 0 1030 DATMS ASC 'FILES SAVED ON ' 1031 MONTH DW 0 1032 DB '/' 1033 DAY DW 0 1034 DB '/' 1035 YEAR DW 0 1036 DB 0 1037 NOSAV ASC 'NO FILES SAVED' 1038 DB 0 1039 * 1040 * 1041 FNAM1 DW 0 1042 DW 0 1043 DW 0 1044 DW 0 1045 DW 0 1046 * 1047 * NAME SEARCH PARAMETERS 1048 * 1049 NALNG DB 0 1050 GTSYM DB 0 1051 LTSYM DB 0 1052 ENLNG DB 0 1053 LPTR DW 0 1054 * 1055 * PARAMETER STORAGE 1056 * 1057 DELMT DB 0 LATEST DELIMITER 1058 TYPPR DB 0 TYPE PROCESSED FLAG 1059 OPFLG DB 0 OPTIONS PROCESSED FLAG 1060 OTSET DB 0 OUTPUT SET FLAG 1061 IPRTF DB 0 INFO PROTECTED FLAG 1062 HEADF DB 0 SUPRESS HEADER FLAG 1063 LISTF DB 0 LIST SAVED FILES FLAG 1064 FTYPE DB 0 TYPE SEARCH FLAG 1065 IMAGF DB 0 IMAGE TYPE FLAG 1066 SAVEF DB 0 INDICATES A FILE WAS SAVED 1067 SRCNT DB 0 FILES SEARCHED COUNT 1068 OUCNT DB 0 FILES OUTPUT COUNT 1069 * 1070 NBRNA DB 0 NUMBER OF NAMES FOR SEARCH 1071 NBPTR DW NABUF NAME BUFFER POINTER 1072 DRPTR DW DABUF DIRECTORY BUFFER POINTER 1073 ENPNT DW DABUF CURRENT ENTRY POINTER 1074 * 1075 OFNUM DB 0 CONSOLE OUTPUT FILE NUMBER 1076 OTNUM DB 0FFH SAVE OUTPUT FILE NUMBER (FF MEANS NOT OPEN) 1077 IFNUM DB 0 CURRENT INPUT FILE NUMBER 1078 ECOUNT DB 0 1079 TOTAL DB 0 1080 FILEN DB 8 FILENUM 1081 LZRO DB 0 1082 ULOCK DB 0 1083 TYPCK DB 0 1094 HDFLG DB 0 FLAG BYTE FOR LIBRARY HEADER 1084 * 1097 * 1098 * HEADER FOR POSSIBLE OUTPUT FILE CREATE 1099 * 1100 DB 'A'+80H FILE TYPE (A FOR ARCHIVE) 1101 DW 4C0H BLOCK SIZE 1102 DB 0 ATTRIBUTES 1103 FBUF DS 20 BUFFER FOR PSCAN USE (FILE NAME FOR CREATE) 0000 * 1104 * 1085 * THE BUFFERS COME NEXT 1086 * 1087 NABUF DS 13*11 UP TO TEN NAMES FOR EACH ENTRY 1088 BUFR DS DRESZ+1 FOR EACH DIRECTORY ENTRY 1089 DABUF DS 256*16 WE READ THE DIRECTORY HERE 1090 DIEND EQU $ THE END OF THE BUFFER 1091 OBUFF DS 63 OUTPUT BUFFER 1092 DS 2 BLOCK SIZE FOR WRITE (BEGINNING OF CBUFF) 1093 CBUFF DS 1000H 4K BUFFER FOR FILE COPYING(MAX BLK SIZ) 1095 DATE DS 3 DATE FILE SAVED (FROM GLOBAL AREA) 1096 * 1105 * EQUATES 1106 * 1107 NMLEN EQU 8 NAME LENGTH 1108 BLKNM EQU BUFR+18 1109 BLKSZ EQU BUFR+9 BLOCK SIZE POINTER 1110 * 1111 * 1112 END 1113 *