TITL GET COMMAND * * * * GET COMMAND * * * DEC 4,1978 * FOR PTDOS 1.5 (MOD 1) * * COPY NPTDEFS * DRESZ EQU 21 LENGTH OF DIRECTORY ENTRY /// SYSTEM REF /// CR EQU 0DH CARRIAGE RETURN LF EQU 0AH LINE FEED * ORG 100H XEQ 100H * LHLD SYSGLO GET GLOBAL AREA LXI D,GLCOF COFILE OFFSET FROM SYSGLO DAD D MOV A,M COFILE STA OFNUM SET AS OUTPUT FILE NUMBER * LXI D,GLUNI-GLCOF GLUNI IS DEFAULT UNIT OFFSET DAD D POINT TO DEFAULT UNIT MOV A,M ADI '0' ASCII OFFSET REQUIRED BY NAMIN STA OUTUN UNIT FOR OUTPUT FILES STA SRUNT INITIALIZE SEARCH UNIT * LHLD SYSGLO SET MEDIUM ERROR TRAP LXI B,GLERM DAD B MVI M,-1 INX H MVI M,-1 * * SCAN OPTIONS, UNITS, TYPES AND NAMES UNTIL END * FINAM CALL FLMCK SCAN TO CR OR ; ONLY MVI A,PSOPT READ TO DELIMITER ONLY LHLD NBPTR PUSH H XCHG CALL PSCAN STA DELMT SAVE THE DELIMITER POP H JC PSCER IF ERROR JZ FINAM IF NO CHRS * * FIND OUT WHICH BRANCH TO TAKE * EQSRH MOV A,M GET READ IN CHAR CPI '=' OPTIONS TYPE? JZ OPNT1 FOUND ONE INX H NOPE SO CHECK NEXT CHAR ORA A SET FLAGS ON CHAR JUST CHECKED JNZ EQSRH KEEP LOOPING UNTIL 0 * * * NAME OR UNIT COME HERE * LHLD NBPTR MOV A,M FIRST TEST IF UNIT CPI '/' JZ UNPRC IF SO THEN PROCESS * * INCREMENT THE NAME BUFFER POINTER * LXI D,13 INCREMENT IT DAD D SHLD NBPTR RE STORE IT MVI M,0 LDA NBRNA INR A STA NBRNA CPI 11 HOW MANY HAVE WE PROCESSED? CNC XNAMS TOO MANY NAMES JMP FINAM * * SCAN OFF THE UNIT * UNPRC INX H MOVE TO THE UNIT MOV A,M GET CHR STA OUTUN SET AS UNIT FOR OUTPUT FILES JMP FINAM AND LOOP UP AND OVER * * * SCAN OPTIONS * * OPNT1 LHLD NBPTR POINT TO START OF BUFFER MOV A,M GET FIRST CHR FROM BUFFER PUSH PSW SAVE FOR LATER * * GOTO THE EQUALS SIGN: ALLOWS "SET= FOR S=" * OPN1A ORA A CZ NOEQ NO EQUALS FOUND? CPI '=' INX H MOV A,M GET NEXT CHR JNZ OPN1A * * PROCESS THE LOT OF THEM * OPN1B POP PSW CALL MAP CONVERT TO UPPER CASE CPI 'T' TYPE? JZ TOPNT TYPE OPTION * CPI 'I' INPUT JZ IPSET * CPI 'S' SWITCH? CNZ BADP NOPE * LDA OPFLG GET OPTION PROCESSED FLAG ORA A CNZ BADP ALREADY PROCESSED THE OPTIONS INR A STA OPFLG JMP SOPNT * * GET THE INPUT FILE NAME OR UNIT * IPSET LDA ITSET SEE IF INPUT IS ALREADY SET ORA A CNZ BADP INR A STA ITSET * MOV A,M GET FIRST CHR FROM BUFFER CPI '/' STAND ALONE UNIT? JZ IPUNT PROCESS IT LXI D,FBUF TEMP BUFFER FOR PSCAN MVI A,PSOP+40H OPEN EXISTING FILE CALL PSCAN CC PSCER MOV A,D ORA A JNZ FBIG FILE NUMBER TOO BIG MOV A,E CPI 0FFH JZ ILFNM STA ITNUM SAVE AS INPUT FILE NUMBER JMP FINAM * * SET SEARCH UNIT * IPUNT INX H GET CHAR AFTER / MOV A,M STA SRUNT JMP FINAM * * * PROCESS SET FLAGS (L,H,I,N,R) * SOPNT MVI B,0 POSSIBLE FLAG STATUS (NOT SET) * GETCH MOV A,M CALL MAP CONVERT TO UPPER CASE INX H ORA A JZ FINAM CPI '-' JNZ LFLAG MVI B,1 NEXT FLAG WILL BE SET JMP GETCH * LFLAG CPI 'L' LIST GOTTEN FILES FLAG JNZ HFLAG MOV A,B STA LISTF JMP SOPNT * HFLAG CPI 'H' SUPPRESS HEADING FLAG JNZ IFLAG MOV A,B STA HEADF JMP SOPNT * IFLAG CPI 'I' INFO PROTECT FLAG JNZ NFLAG MOV A,B STA IPRTF JMP SOPNT * NFLAG CPI 'N' NO OVERWRITE FLAG JNZ RFLAG MOV A,B STA NOOWF JMP SOPNT * RFLAG CPI 'R' REPORT ONLY FLAG CNZ ILLOP MOV A,B STA REPF JMP SOPNT * * * PROCESS THE TYPE OPTION * TOPNT LDA TYPPR GET THE TYPE OPTION SET FLAG ORA A JNZ BADP ALREADY DID IT MOV A,M GET DESIRED TYPE CPI 'I' POSSIBLE IMAGE TYPE? JNZ DFILE MVI A,-1 SET IMAGE FLAG STA IMAGF INX H GET NEXT CHAR MOV A,M ORA A IF IS 0 THEN TYPE IS 'I' JNZ NORM MVI A,' ' TYPE I IS ASCII BLANK JMP NORM * DFILE CPI 'D' DEVICE FILE? JNZ NORM STANDARD TYPE MVI A,-1 SET DEVICE TYPE * NORM CPI '#' CHECK FOR NUMBER INPUT JNZ ITEST MVI A,PSV+40H CONVERT NUMBER USING PSCAN INX H MOVE TO NUMBER LXI D,FBUF SCRATCH BUFFER FOR PSCAN CALL PSCAN CC NUMER JZ TYNUM NO NUMBER FOLLOWING # MOV A,D CHECK NUMBER: MUST BE LESS THAN 256 ORA A CNZ NUMER IF D NOT 0 THEN ERROR MOV A,E JMP ITEST * TYNUM MVI A,'#' NO NUMBER AFTER # MEANS TYPE # * ITEST MOV C,A SAVE TYPE LDA IMAGF CHECK IMAGE FLAG ORA A MOV A,C JNZ SETY1 IF IMAGE THEN LEAVE HIGH BIT CLEAR * SETY ORI 80H * SETY1 STA FTYPE SET THE TYPE IN MVI A,-1 STA TYPPR SET TYPE OPTION JMP FINAM AND GO BACK * * * FLMCK LDA DELMT CPI ';' JZ FSAVE CPI 0DH RNZ * * * RESTORE AND SET UP INIT PARAMS * FSAVE EQU $ * HDMSG LHLD NBPTR MVI M,0 BE SURE THE LAST NAME IS NOT HERE LDA ITNUM CHECK IF INPUT FILE WAS SPECIFIED CPI 0FFH JNZ HEADR SKIP READING IN DIRECTORY * * * OPEN "DIRECTRY" AND READ IT TO THE BUFFER * LXI D,DMSG POINTER TO ASCII "DIRECTRY" CALL FOPEN OPEN THE DIRECTRY STA FILEN * * READ IN THE DIRECTORY INFORMATION * LXI D,DABUF THE DIRECTORY BUFFER LXI B,256*16 JUST EXACTLY ENOUGH CALL SYS FILE # IN A FROM FOPEN DB RBLOP READ BLOCK CALL DIRER CLOSE THE DIRECTORY BEFORE RETURN * * NOW CLOSE IT * CALL FCLOS NOW CLOSE DIRECTRY FILE (# STILL IN A) JMP HEADR * * * OUTPUT HEADER MESSAGE * HEADR CALL CRLF LDA HEADF SEE IF SUPPRESS HEADER ORA A JNZ LINIT SKIP IF NON ZERO LDA LISTF IF WE ARE NOT LISTING FILES, WE DON'T NEED ORA A THE HEADING EITHER JNZ LINIT * LXI H,HMSG HEADER MESSAGE BUFFER ADDRESS MVI E,1 CALL SPAC2 CALL CRLF LXI H,HMSG1 MVI E,5 CALL SPAC2 CALL CRLF * * NOW MAKE IT PRETTY * MVI E,64 * FMLOP DCR E JZ HDR2 MOV A,E RRC MVI B,'-' JNC FMOUT MVI B,'+' * FMOUT CALL WRITB JMP FMLOP * HDR2 CALL CRLF * * LINIT MVI A,1 RESET JUST GOT FLAG STA GETF LXI H,DABUF INITIALIZE DIRECTORY BLOCK POINTER SHLD DRPTR MOV A,M INIT ENTRY COUNT INR A FUDGE IT STA ECOUNT INX H GET PAST COUNT AND POINTER INX H SHLD ENPNT CURRENT ENTRY POINTER * * LOOP HERE FOR EACH DIRECTORY ENTRY PROCESSED * SLOOP LXI H,NABUF RESET THE NAME BUFFER POINTER SHLD NBPTR * CALL GETDE READ NEXT DIRECTORY ENTRY INTO BUFR * * GET NEXT NAME INTO THE NAME BUFFER * NAMIN CALL INTST CHECK FOR QUIT CHAR LHLD NBPTR GET NAME BUFFER POINTER MOV A,M ORA A STA FNAM1 BE SURE ITS ZERO FOR PASS NAME JZ ENTR SKIP THE NAME XRA A STA LTSYM STA GTSYM LXI D,FNAM1 FILE NAME GOES HERE * * MOVE IN THE NAME * MVI C,8 * PRCS0 MOV A,M CPI '/' SOWHAT IF THEY GOOFED JZ PRCAB ORA A ALL DONE? JZ PRCAB INX H * * VALID CHR OR PROCESS SYMBOL * CPI '>' JZ PRC1A CPI '<' JZ PRC1B STAX D INX D DCR C JMP PRCS0 * PRC1A STA GTSYM JMP PRCS0 * PRC1B STA LTSYM JMP PRCS0 * * PRCAB XCHG . BE SURE TO TERMINATE WITH ZERO MVI M,0 MOV A,C CALCULATE LENGTH OF NAME SUI 8 CMA INR A STA NALNG * * TEST NAME TO SEE IF IT MATCHES CURRENT ENTRY * AND GET FILE IF IT DOES * ENTR XRA A RESET JUST GOT FLAG STA GETF CALL PRINT TEST AND GET LDA GETF CHECK IF A FILE WAS GOTTEN ORA A JNZ SLOOP IF SO GO TO NEXT ENTRY LHLD NBPTR CHECK IF THIS NAME WAS 0 (GET ALL) MOV A,M ORA A JZ SLOOP IF SO THEN NEXT ENTRY LXI D,13 MOVE POINTER TO NEXT NAME DAD D MOV A,M CHECK FOR NAMES DONE ORA A JZ SLOOP IF SO, NEXT ENTRY SHLD NBPTR STORE NEW POINTER JMP NAMIN PROCESS NEW NAME * * * GETDE * GETDE LDA ITNUM DECIDE WHERE TO GET ENTRY FROM CPI 0FFH CHECK FOR LIB FILE JNZ LIBGT * * GET ENTRY FROM DISK DIRECTORY IN MEMORY * DIRGT LDA ECOUNT UPDATE ENTRY COUNT DCR A STA ECOUNT JZ NXBLK IF NONE LEFT MOVE TO NEXT BLOCK CALL READ PUT CURRENT ENTRY INTO BUFR LHLD ENPNT UPDATE ENTRY POINTER LXI D,DRESZ DAD D SHLD ENPNT RET * NXBLK LHLD DRPTR MOVE TO NEXT DIRECTORY BLOCK(256 BYTES) LXI D,256 DAD D SHLD DRPTR MOV A,H CHECK FOR END OF DIRECTORY CPI DIEND JNC EOF * STBLK LHLD DRPTR INTIALIZE ENTRY POINTER AND COUNT MOV A,M INR A FUDGE COUNT STA ECOUNT INX H MOVE PAST COUNT AND POINTER INX H SHLD ENPNT JMP DIRGT GO READ ENTRY * * GET ENTRY FORM LIB FILE * LIBGT LDA GETF CHECK IF FILE DATA WAS READ ORA A JNZ HDRD CALL HSPAC IF NOT, SPACE TO NEXT HEADER * HDRD LXI D,BUFR WHERE TO PUT HEADER (ENTRY) LXI B,17 17 BYTES IN HEADER LDA ITNUM LIB FILE # CALL SYS READ IT DB RBLOP CALL TSEND RET * * TSEND CPI EREOF IF ERROR WASN'T EOF JNZ PTDER REAL ERROR OCCURED MOV A,C CHECK IF PARTIAL HEADER WAS READ CPI 17 JNZ FBAD IF SO FILE HAD BAD FORMAT POP H GET RID OF RETURN ADDR JMP EOF ALL DONE GETTING * * READ BLOCK * READ LHLD ENPNT GET ENTRY BUFFER LXI D,BUFR AND MOVE IT TO BUFR MVI C,DRESZ * READ1 MOV A,M STAX D INX H INX D DCR C JNZ READ1 RET * * * END OF FILE * * MESSAGES CODE GOES HERE EOF EQU $ * * OUTPUT ACTION TAKEN * CALL CRLF LDA GOTTN CHECK IF ANY FILES WERE GOTTEN ORA A JZ NONE NOPE SO SAY SO * MOV B,A CONVERT # GOTTEN TO ASCII CALL HEX2A MOV A,D HIGH DIGIT CPI '0' SUPPRESS LEADING 0 JZ LOW STA HGOTN PUT HIGH DIGIT INTO MESSAGE * LOW MOV A,E STA LGOTN PUT LOW DIGIT INTO MESSAGE JMP ENDLN * NONE LXI H,'ON' PUT 'NO' INTO FILES GOTTEN MESSAGE SHLD HGOTN * ENDLN LXI H,ENDMS PRINT FINAL MESSAGE CALL MESG * * CLOSE INPUT FILE * ICLOS LDA ITNUM FILE # CPI 0FFH SEE IF INPUT FILE USED JZ ENDF IF NOT JUST RETURN CALL FCLOS * ENDF CALL SYS DB RETOP * ENDMS DW 0F03H SPACE AND LETTER COUNT FOR FINAL MESSAGE * HGOTN DB ' ' LGOTN DB ' ' ASC ' FILES GOTTEN' * * * * ERROR HANDLING * PSCER MOV A,E PSCAN ERROR CHECK WHAT KIND OF ERROR ORA A JNZ GENER IF PTDOS ERROR THEN GO TO GENERAL ERROR LXI H,FLDER FIELD ERROR JMP ERMES * * FLDER ASC 'FIELD ERROR' DB 0 * GENER STA ERMCD ERROR # CODE POP H GET RETURN ADDRESS FOR 'CALLED FROM' MESSAGE DCX H CHANGE ADDRESS TO ACTUAL CALL DCX H DCX H DCX H DCX H DCX H MVI A,03H FLAGS SPECIFY CALLED FROM MESSAGE JMP ERROR * PTDER STA ERMCD HANDLE STANDARD PTDOS TYPE ERROR POP H GET RETURN ADDRESS DCX H GO BACK TO CALL SYS OP DCX H DCX H DCX H MOV A,M PUT IT IN COMMAND CODE STA COMCD DCX H MOVE BACK TO ADDRESS OF ACTUAL CALL DCX H DCX H MVI A,03H SET UP FOR 'CALLED FROM MESSAGE' JMP ERROR * DIRER PUSH PSW SAVE THE ERROR NUMBER LDA FILEN CALL SYS DB CLOOP NOP . DO NOTHING ABOUT ERROR HERE. 1ST MORE IMPORTANT NOP NOP POP PSW GET BACK ERROR AND ABORT JMP PTDER * XNAMS LXI H,TOMNY JMP ERMES * TOMNY ASC 'TOO MANY NAMES' DB 0 * NOEQ LXI H,NOEQM JMP ERMES * NOEQM ASC 'NO EQUALS SIGN IN OPTION ARGUMENT' DB 0 * BADP LXI H,BADPM JMP ERMES * BADPM ASC 'BAD OPTION ARGUMENT' DB 0 * FBIG LXI H,FBIGM JMP ERMES * FBIGM ASC 'FILE NUMBER TOO LARGE' DB 0 * FBAD LXI H,FBADM JMP ERMES * FBADM ASC 'INPUT FILE NOT LIBRARY FORMAT' DB 0 * ILFNM MVI A,ERIFI ILLEGAL FILE NAME JMP ERCOD * ILLOP MVI A,ERIOS ILLEGAL OPTION SPECIFIER JMP ERCOD * NUMER MVI A,ERIVA ILLEGAL VALUE JMP ERCOD * * ERMES MVI A,00H INDICATE ERROR MESSAGE ONLY JMP ERROR * ERCOD STA ERMCD ERROR MESSAGE CODE ONLY XRA A CLEAR FLAG ARGUMENT LXI H,-1 NO MESSAGE * ERROR PUSH PSW SAVE FLAG ARGUMENT LDA OTNUM CLOSE OUTFILE CALL SYS DB CLOOP NOP . INGNORE ERRORS NOP . NOP . * LDA IFNUM CLOSE INFILE CALL SYS DB CLOOP NOP . NOP . NOP . * LDA ITNUM CHECK IF INPUT FILE STILL OPEN CPI 0FFH JZ APOP CALL SYS IF SO TRY TO CLOSE IT DB CLOOP NOP . IGNORE ANY ERROR NOP NOP * APOP CALL RTYPE RESTORE TYPE AND ATTRIBUTES OF FILES POP PSW GET FLAGS BACK CALL UTIL CALL ERROR HANDLER DB UXOP JMP ABORT NO ERROR RETURN EXPECTED. HOWEVER... * COMCD DB -1 POSSIBLE CALL SYS OP ERMCD DB -1 POSSIBLE ERROR CODE ABORT CALL SYS A FINAL RESORT DB ABTOP * * RTYPE LDA RTPI HAS INFILE'S TYPE BEEN CHANGED (FROM DEVICE) ORA A JZ RTYPO NOPE, CHECK OUTFILE LDA SRUNT YES, SET TO INFILE'S UNIT LHLD UNADR MOV M,A LXI D,FNAM1 MVI H,-1 RETYPE BACK TO DEVICE CALL SYS DB CHTOP NOP . IGNORE ERRORS NOP . NOP . LDA BUFR+11 RESTORE ATTRIBUTES ALSO MOV H,A CALL SYS DB CHAOP NOP . NOP . NOP . XRA A RESET TYPE CHANGED FLAG STA RTPI * RTYPO LDA RTPO HAS OUTFILE'S TYPE BEEN CHANGED (FROM DEVICE) ORA A JZ KILO NOPE LDA OUTUN YES, SET TO OUTFILE'S UNIT LHLD UNADR MOV M,A LXI D,FNAM1 MVI H,-1 RETYPE IT BACK TO DEVICE CALL SYS DB CHTOP NOP . NOP . NOP . LDA OBUFF+14 RESTORE IT'S ATTRIBUTES ALSO MOV H,A CALL SYS DB CHAOP NOP . NOP . NOP . XRA A RESET TYPE CHANGED FLAG STA RTPO * KILO LDA CREFLG WAS OUTFILE JUST CREATED? ORA A RZ . NOPE LDA OUTUN YES, WELL LET'S KILL IT OFF LHLD UNADR SET TO OUTFILE'S UNIT MOV M,A LXI D,FNAM1 CALL SYS DB KILOP NOP . NOP . NOP . XRA A STA CREFLG RET . * * * * COMPARE AND POSSIBLY GET * PRINT LDA TYPPR ORA A JZ INFTS PRINT ALL TYPES LDA FTYPE GET DESIRED TYPE LXI H,BUFR+8 GET TYPE CMP M CHECK IF TYPE IS THE ONE WE WANT RNZ . NO, GET NEXT FILE * INFTS LDA IPRTF CHECK INFO PROTECT OPTION ORA A JNZ PRNIT IF FLAG SET SAVE EVERYTHING LDA BUFR+11 GET ATTRIBUTES ANI 08H MASK OFF ALL BUT INFO PROTECT RNZ . IF SET DON'T SAVE THIS FILE * * CODE TO SEARCH FOR NAME * PRNIT LHLD NBPTR SEARCH FOR NAME MOV A,M ORA A JZ PRIN2 * * SEARCH FOR THIS NAME * MVI A,8 LETTERS LEFT TO TEST IN ENTRY NAME STA ENLNG LXI H,BUFR-1 BEGINNING OF ENTRY NAME (FUDGED) SHLD LPTR STORE FOR NEXT TIME AROUND * NLOOP LXI D,FNAM1 NAME TO COMPARE TO ENTRY LDA NALNG GET LENGTH OF THIS NAME INR A FUDGE IT MOV C,A STAYS IN C LDA ENLNG CURRENT LENGTH OF ENTRY NAME INR A FUDGE IT MOV B,A STAYS IN B * N2LOP INX H NEXT LETTER IN ENTRY NAME MOV A,M CHECK IF NAME IS DONE ORA A CHECK FOR ZERO BYTE JZ ENEND DCR B CHECK FOR MAX LENGTH OF ENTRY NAME REACHED JZ ENEND DCR C CHECK FOR END OF INPUT NAME JZ INEND * PUSH B LDAX D COMPARE THE 2 CURRENT CHARS CALL MAP CONVERT TO UPPER CASE MOV B,A SAVE IT INX D MOV A,M CALL MAP CONVERT TO UPPER CASE CMP B CHECK THE CHARACTERS POP B JZ N2LOP IF = KEEP CHECKING JMP NOMAT OTHERWISE NO MATCH THIS ROUND * ENEND DCR C CHECK IF BOTH NAMES ENDED TOGETHER JZ MATCH IF SO, BINGO! JMP NOMAT OTHERWISE ZONK THIS ROUND * INEND LDA GTSYM CHECK IF OK IF INPUT ENDED 1ST ORA A JNZ MATCH IF > INPUT THEN YIPPEE * * NAMES DIDN'T MATCH THIS ROUND * SEE IF WE GO FOR ANOTHER * NOMAT LDA LTSYM CHECK IF NAME BEGINNINGS MUST MATCH ORA A RZ . IF SO THEN THESE NAMES DON'T LDA ENLNG CHECK IF WE REACHED END OF ENTRY NAME DCR A RZ . IF SO THEN WE DIDN'T MATCH STA ENLNG STORE NEW LENGTH LHLD LPTR SET NEW ENTRY NAME POINTER INX H SHLD LPTR JMP NLOOP * * * COPY GET:S2/1 * END