/DIRECT FOR DECSYSTEM-8 /BY HARVEY MABRY - DIGITAL COMMUNICATIONS ASSOCIATES / ATLANTA, GEORGIA /**UPDATE** /5/24/73 -DEW / CONDITIONAL ASSEMBLY PARAMETER ADDED TO ALLOW / REMOVING LPT AS DEVAULT DEVICE AFTER DIR. ALSO / IF TTY: IS OUT DEVICE NO FORMFEEDS ARE PRINTED / AND THE COMMAND LINE IS NOT ECHOED. /ACCEPTED INTO DECSYSTEM-8 AFTER /KV8I CODE ADDED BY JOHN COVERT, GT ICS /CONSIDERABLE OPTIMIZING DONE 5/4/73, JRC FIELD 1 LXR=14 /THE FOLLOWING DEFINES THE WIDTH AND HEIGHT OF DEVICES... /MAY BE CHANGED BY PRECEDING ASSEMBLY WITH A DEFINITIONS FILE DECIMAL IFNDEF LPTWTH < LPTWTH=132 > IFNDEF LPTHGT < LPTHGT=66 > IFNDEF TTYWTH < TTYWTH=71 > IFNDEF TTYHGT < TTYHGT=27 > /FOR KV8/I OUTPUT DEFINE KV8OPT=1 IFNDEF KV8OPT /THE NORMAL ORDER OF DEFAULT OUTPUT /DEVICES ARE: DIR,LPT,TTY. TO MAKE THE ORDER DIR,TTY /WITH LPT OUTPUT ONLY ON /L OPTION: / DEFINE NOLPTDEFALT=1 IFNDEF NOLPTD OCTAL COMBUF=1600 /COMMAND BUFFER BEGINNING (PS/8) MDATE=7666 /MONITOR DATE LOCATION SBFTOP=6600 SBUFST=0 *4000 NOP /ALLOW EITHER RUN OR CHAIN CLA CDF 0 TAD I (LXR CDF 10 DCA TEXTPT GNAME, DCA WILD /RETURN HERE TO GET A NAME (INITIALLY OR TAD (50 /AFTER HANDLING A DEVICE) DCA MASK IAC DCA HALF TAD (MASK DCA NMFMPT DCA NM1 /CLEAR OUT COMMAND LINE NAME FOR NEXT TIME DCA NM2 DCA NM3 DCA NM4 ONA, CLA /GET NEXT CHARACTER JMS GETCH JMS DISPATCH " ONA /IGNORE SPACES ALTOGETHER "/ OPTION /SINGLE LETTER OPTION "( OPTS /MULTIPLE OPTIONS "* ASTER /HANDLE THIS KIND OF WILD CARD "? QMARK /HANDLE THIS KIND ". PER /HANDLE EXTENSION ": COL /PREVIOUS STUFF WAS A DEVICE NAME 0 CONT /END OF COMMAND LINE -1 TAD CHAR /ANY OTHER CHARACTER JMS DECODE JMP SYNTAX /ERROR RETURN FROM DECODE SZL TAD (57 IAC DCA CHAR CLL CML JMS SAVECH JMP ONA /GO TO HANDLE NEXT CHAR OPTION, JMS GETCH /HANDLE SINGLE LETTER OPT, GET CHARACTER JMS SLSHCH /HANDLE THE OPTION LETTER - NUMBER JMP ONA /NOW GET NEXT CHAR OPTS, JMS GETCH /MULTIPLE LETTER OPTIONS, GET CHAR TAD (-") /IS IT ")" (END OF OPTIONS) SNA CLA JMP ONA /YES, GO ON WITH STANDARD SCAN TAD CHAR /NO, GET CHAR BACK AND JMS SLSHCH /HANDLE AS OPTION JMP OPTS /NOW GET ANOTHER ONE UNTIL ")" FOUND ASTER, DCA CHAR /HANDLE ASTERISK CLL JMS SAVECH SMA CLA JMP ASTER+1 /MARK THE REST AS WILD MATCH OND, ISZ WILD / JMP ONA /GET NEXT CHARACTER QMARK, DCA CHAR /HANDLE QMARK WILD CLL JMS SAVECH CLA JMP OND /FINISH UP ONE CHAR WILD, AND GO ON SCANNING PER, TAD NMFMPT /THE REST IS AN EXTENSION CIA TAD (MASK /PERIOD MUST COME AFTER A NAME HAS BEEN STARTED SZA CLA ISZ PERSW /ALSO, THERE MUST BE ONLY ONE JMP SYNTAX DCA CHAR CLL CML JMS SAVECH /MOVE OVER THE REST OF THE NAME SMA JMP .-3 RAL CLL RAR DCA MASK JMP ONA /WE ARE SET UP, NOW GET THE EXTENSION COL, TAD WILD /WE HAVE A COLON, SO PRECEDING IS DEV SNA CLA ISZ COLON JMP SYNTAX /WE EITHER HAD WILD STUFF IN DEV, OR TWO ":"S TAD NM1 DCA DEV1 /MOVE TAD NM2 DCA DEV2 JMP GNAME /AND SET UP TO GET MORE NAME GETCH, 0 /GET ONE CHARACTER FROM COMMAND BUFFER CDF 0 TAD I TEXTPT CDF 10 DCA CHAR /SAVE FOR FUTURE REFERENCE TAD CHAR ISZ TEXTPT /BUMP POINTER JMP I GETCH TEXTPT, 0 0 /LOCATION FOR NEG. # OF ADDITIONAL WORDS MASK, 0 NM1, 0 NM2, 0 NM3, 0 NM4, 0 PERSW, -1 COLON, -1 WILD, 0 CHAR, 0 PAGE SLSHCH, 0 /HANDLE AN OPTION CHARACTER SZA JMS DECODE /CHECK A-Z,0-9 JMP SYNTAX /ILLEGAL CHAR CLA TAD CHAR JMS DISPATCH /CHECK THE CHAR AGAINST THE FOLLOWING TABLE "A OPA /ALPHABETIZE "E OPE /LIST EMPTIES "F OPF /SHORT - ONLY FILE NAMES "L OPL /GO TO LPT IF POSSIBLE "T OPT /GO TO TTY "W OPW /WIDE FORMAT - MAY BE FOLLOWED BY COLON... "H HEADER /PARAMETER BLOCK HEADER. "N UDEVN /JUST USER-DEVICE-NAME HEADER. -1 SLSHCR, JMP I SLSHCH /RETURN - IGNORE ILLEGAL OPTIONS - NO ERROR OPA, CMA DCA OPTA /SET ALPHABETIZE FLAG JMP I SLSHCH OPE, CMA DCA OPTE /SET LIST EMPTIES FLAG JMP I SLSHCH OPF, CMA DCA OPTF /SET SHORT LISTING FLAG JMP I SLSHCH OPW, JMS GETCH /WIDE LISTING - LOOK AT NEXT CHAR TAD (-": /IF IT IS A COLON SZA CLA JMP NONUM /NO, IT ISNT JMS GETCH /IT WAS - LOOK AT NUMBER AFTERWARDS JMS DECODE /CHECK TO SEE IF NUMERIC SKP /NOT ALPHANUMERIC SNL /SKIPS IF NUMERIC, NOT IF ALPHABETIC JMP SYNTAX /WAS NOT A NUMBER DCA N /STORE NUMBER IN N COLUMNS JMP I SLSHCH NONUM, CLA CMA /W WAS NOT FOLLOWED BY A COLON TAD TEXTPT /BACK UP TEXT POINTER DCA TEXTPT DCA N /IF N IS ZERO, USE DEFAULT WIDTH JMP I SLSHCH DECODE, 0 /SUBROUTINE TO CHECK OPTION RANGE TAD (-"9-1 /VERIFIES IF WITHIN A-Z, 0-9 CLL TAD ("9+1-"0 SZL JMP DIGIT TAD ("0-"Z-1 CLL CML TAD ("Z+1-"A SNL DIGIT, ISZ DECODE JMP I DECODE OPL, JMS SETLPT /L OPT - SET TO GO TO LPT JMP I SLSHCH JMP LPTNA /COULD ASSIGN LPT.. OPT, JMS SETTTY /OPTION T - SET TTY OUTPUT JMP I SLSHCH SAVECH, 0 /SAVE NEXT CHARACTER OF A NAME TAD MASK SPA JMP I SAVECH /DONT OVERFLOW NAME TABLE RAL DCA MASK TAD HALF /SWITCH HALF CIA DCA HALF TAD CHAR /GET CHAR AND HANG ON TO IT ISZ HALF /WHILE WE DECIDE WHICH HALF JMP LOWER /RIGHT ISZ NMFMPT /LEFT CLL RTL RTL RTL LOWER, TAD I NMFMPT /COMBINE WITH POSSIBLE PREVIOUS CHARACTER DCA I NMFMPT /AND STORE BACK JMP I SAVECH CONT, TAD NMFMPT /WE HAVE FINISHED SCANNING COMMAND LINE CIA TAD (MASK SNA CLA JMP CONTA /WE HAD NO NAME SPECIFIED ALLNOM, DCA CHAR CLL CML JMS SAVECH /ZERO OUT REST OF NAME SMA JMP ALLNOM+1 ISZ PERSW /EXTENSION? JMP FINMSK /WAS SPECIFIED RAL /WAS NOT, ZERO IT OUT CLL RAR DCA MASK JMP ALLNOM+1 FINMSK, CLL RAL /FINISH UP MASKING CLL RAL RTL CONTA, DCA MASK JMP SETDEV /GO ON TO SET UP DEVICES OPTA, 0 N, 1 HALF, 1 NMFMPT, MASK PAGE SETDEV, TAD XXDI /DI SET UP NAME FOR POSSIBLE OUTPUT FILE DCA I (7601 TAD DEV1 /WILL BE DIXXXX.LS DCA I (7602 /WHERE XXXX IS THE INPUT (DIRECTORY) DEVICE TAD DEV2 DCA I (7603 TAD (1423 /LS DCA I (7604 JMS USR /GET DEV NO OF INPUT DEVICE 12 /INQUIRE DEV1, DEVICE DSK /DSK IS DEFAULT - MAY BE CHANGED IN COMMAND DEV2=.-1 0 JMP DEVNA /DEVICE SPECIFIED IS NOT AVAILABLE TAD DEV2 /CHECK TO SEE IF DEVICE IS FILE STRUCTURED TAD (7760-1 DCA DEV2+1 TAD I DEV2+1 SMA CLA JMP NODIR /DEVICE DOESNT HAVE A DIRECTORY... TAD DEV2 TAD (7640 DCA NFILE TAD COLLEN /IF COLLEN IS ALREADY SPECIFIED, SZA CLA JMP BYPASS /THEN WE HAD /T OR /L -DONT LOOK FOR DIR JMS USR /SEE IF THERE IS A DEVICE CALLED DIR 12 /INQUIRE XXDI, DEVICE DIR DIRN=.-1 0 IFZERO KV8OPT /NO DIR, SO TAKE DEFAULT IFNZRO KV8OPT /FOR KV8, KV IS DEFAULT TAD DIRN LABGY, JMS LPDCAS /DO THE SETUP PARAMS JMP BYPASS LABG, IFZERO NOLPTD < JMS SETLPT JMP BYPASS> JMS SETTTY BYPASS, JMS OCRLF /OUTPUT INPUT COMMAND LINE /BYPASS MODIFIED IF TTY OUT DEV. TAD (". JMS OPUTCH TAD (COMBUF DCA TEXTPT TITLOP, JMS GETCH SNA JMP TITOUT /FINISHED JMS OPUTCH JMP TITLOP TITOUT, JMS OCRLF TAD I (MDATE JMS XDATE /OUTPUT CURRENT DATE TAD (-14 JMS XPRINT DA1 JMS OCRLF JMP I (HEADR /GO PRINT HEADER IF OPTED FOR LPDCAS, 0 /DOES SOME DCA'S NEEDED A FEW TIMES. DCA I (7600 /DEVICE NUMBER TAD (LPTWTH DCA LWDTH TAD (LPTHGT-20 DCA COLLEN JMP I LPDCAS SETLPT, 0 /SET LPT AS OUTPUT DEVICE JMS USR 12 /INQUIRE DEVICE LPT 0 ISZ SETLPT /NO LPT, SET UP FOR ERROR EXIT TAD .-3 JMS LPDCAS /DO SETUP JMP I SETLPT SETTTY, 0 /SET TTY AS OUTPUT DEVICE JMS USR /WE MUST GET DEVICE NUMBER OF TTY 12 /BECUASE SOME BUILD MAY HAVE IT FUNNY DEVICE TTY 0 JMP I (TTYNA /HUH? TAD .-3 DCA I (7600 /DEVICE NUMBER TAD (TTYWTH DCA LWDTH TAD (TTYHGT-4 DCA COLLEN TAD (212 /CHANGE FORMFEED TO 212 DCA FORMF TAD (JMP TITOUT /(OR TAD TITLOP+2 IF NECESSARY DCA BYPASS /NO COPY OF COMMAND IF TTY JMP I SETTTY PAGE CLRBUF, TAD STORAGE /CLEAR OUT THE BUFFER DCA AUTO TAD (-SBFTOP+SBUFST DCA COUNT JMS DIAUTO ISZ COUNT JMP .-2 DCA RECORD TAD STORAGE DCA AUTO TAD (MASK-1 JMS DIRSRH /FIRST SEARCH JMP CHECKR /DIDNT FIND MATCHES, CHECK CASE JMP YES PKLOOP, JMS DIRSRH /LOOP ON LOOKUP JMP PACKED /WE HAVE ALL ENTRIES YES, DCA ENTRY ISZ RECORD TAD (-4 DCA COUNT JMS TENTRY SZA JMP LABI+1 CMA JMS DIAUTO ISZ COUNT JMP .-2 TAD OPTF SZA CLA JMP PKLOOP TAD MASK-1 SZA CLA JMS DIAUTO JMP NODATE LABI, JMS TENTRY JMS DIAUTO ISZ COUNT JMP .-3 TAD OPTF SZA CLA JMP PKLOOP TAD MASK-1 SNA CLA JMP NODATE JMS TENTRY JMS DIAUTO TAD MASK-1 CMA TAD ENTRY DCA ENTRY NODATE, JMS TENTRY CIA JMS DIAUTO JMP PKLOOP PACKED, JMS FREEOT /WE HAVE FINISHED GETTING NAMES TAD AUTO DCA SORTH TAD OPTF SNA CLA JMP LABC TAD (4 DCA RECLEN TAD (-16 JMP SETLEN LABC, TAD MASK-1 SZA CLA JMP LABD TAD (5 DCA RECLEN TAD (-22 SETLEN, JMP SETL TENTRY, 0 TAD I ENTRY ISZ ENTRY JMP I TENTRY DIAUTO, 0 CDF 0 DCA I AUTO CDF 10 ISZ AUTO JMP I DIAUTO AUTO, 0 ENTRY, 0 COUNT, 0 RECORD, 0 FBLK, TEXT / FREE BLOCKS/ FREEOT, 0 /THIS SUBROUTINE PRINTS NUMBER OF FREE BLOCKS JMS OCTDEC TAD (-4 JMS XPRINT NOBLK1 TAD (-14 JMS XPRINT FBLK JMS OCRLF JMP I FREEOT CHECKR, JMS FREEOT /FIRST OUTPUT THE FREE BLOCK (N IS IN AC) TAD I (NM1 /WE RETURNED FROM DIRSH WITH NO NAMES, SZA CLA /SO IF A NAME WAS SPECIFIED, WE MUST TELL JMP I (NMATCH /HIM IT WAS NOT FOUND - THIS LINE DOES THAT /OTHERWISE, HE TRIED TO LIST A DEVICE WITH A JMP I (CLOSEN /ZERO DIRECTORY, SO TELL HIM HOW BIG, AND QUIT PAGE LABD, TAD (6 DCA RECLEN TAD (-33 SETL, DCA MCOLWD ISZ OPTA /IS SORT OPTION SET? JMP .+4 CDF 0 JMS SORT /YES, DO IN-PLACE SORT CDF 10 TAD RECLEN CIA DCA CTTER TAD COLLEN ISZ CTTER JMP .-2 DCA WDSNCL TAD COLLEN CIA DCA MCOLLN TAD N SZA JMP GOTNA+2 TAD LWDTH TAD MCOLWD SPA JMP .+3 ISZ NA JMP .-4 GOTNA, CLA TAD NA CIA DCA NA NXTPAG, DCA FLAGL DCA NR DCA NUMCOL TAD RECORD TAD MCOLLN SPA SNA JMP .+3 ISZ NUMCOL JMP .-4 SZA ISZ NR CIA TAD MCOLLN DCA FRACT TAD NR TAD NUMCOL TAD NA SPA SNA CLA JMP ALLOK CMA DCA FLAGL TAD NA CMA DCA NUMCOL TAD MCOLLN DCA FRACT ALLOK, TAD NUMCOL SZA CLA JMP .+3 TAD FRACT SKP TAD MCOLLN DCA BCT TAD STORAGE DCA BASE JMP .+4 ONB, TAD BASE TAD RECLEN DCA BASE TAD BASE DCA THSREC JMS OCRLF JMS PRTHSR TAD NUMCOL SNA JMP TSTB CIA DCA CCT ONC, TAD THSREC TAD WDSNCL DCA THSREC JMS PRTHSR ISZ CCT JMP ONC ISZ FRACT JMP TSTB CMA TAD NUMCOL DCA NUMCOL TSTB, ISZ BCT JMP ONB JMS OCRLF ISZ FLAGL SKP JMP MORE CLOSEN, TAD ("Z-100 /PUT OUT A Z, AND QUIT JMS OPUTCH /OUTPUT ROUTINES QUIT ON Z CTTER, 0 MCOLWD, 0 WDSNCL, 0 MCOLLN, 0 LWDTH, 0 NA, 0 FLAGL, 0 NR, 0 NUMCOL, 0 FRACT, 0 BCT, 0 BASE, 0 THSREC, 0 CCT, 0 COLLEN, 0 PAGE MORE, TAD NA DCA CT TAD COLLEN ISZ CT JMP .-2 DCA NRCRDS TAD NRCRDS CIA TAD RECORD DCA RECORD TAD RECLEN CIA DCA CT TAD NRCRDS ISZ CT JMP .-2 TAD STORAGE DCA STORAGE TAD FORMF /OUTPUT FORMFEED JMS OPUTCH JMP NXTPAG /AND START A NEW PAGE PRTHSR, 0 TAD (-16 DCA CT TAD (NME1 DCA NRCRDS DCA I NRCRDS ISZ NRCRDS ISZ CT JMP .-3 TAD THSREC DCA NRCRDS JMS TIBUF CMA SNA JMP OUTNA1 CMA DCA NME1 JMS TIBUF DCA NME2 JMS TIBUF DCA NME3 JMS TIBUF SNA JMP NAMOUT DCA ONTEMP TAD ONTEMP AND (7700 CLL RTR RTR RTR TAD (5600 DCA NME4 TAD ONTEMP AND (77 CLL RTL RTL RTL DCA NME5 NAMOUT, TAD OPTF SZA CLA JMP PR TAD MASK-1 SZA CLA JMS DATE JMS TIBUF JMS OCTDEC PR, TAD MCOLWD JMS XPRINT NME1 JMP I PRTHSR DATE, 0 JMS TIBUF JMS XDATE JMP I DATE OUTNA1, TAD (7405 / DCA NME4 TAD (3 TAD NRCRDS DCA NRCRDS JMP NAMOUT TIBUF, 0 CDF 0 TAD I NRCRDS CDF 10 ISZ NRCRDS JMP I TIBUF CT, 0 NRCRDS, 0 ONTEMP, 0 STORAG, SBUFST /STORAGE FORMF, 214 /GETS CHANGED TO 212 IF TTY OUTDEV. PAGE XDATE, 0 /DECODE DATE SNA JMP I XDATE DCA DATEMP TAD DATEMP AND (7400 CLL RAL RTL RTL JMS OCTDEC TAD NOBLK2 DCA DA1 TAD DATEMP AND (370 CLL RAR RTR JMS OCTDEC TAD DECICH+2 TAD (5700 DCA DA2 TAD DECICH+3 CLL RTL RTL RTL TAD (57 DCA DA3 TAD DATEMP AND (7 TAD (6760 DCA DA4 JMP I XDATE OCTDEC, 0 /OCTAL-DECIMAL CONVERSION JMS DIV -1750 DCA REM TAD INTEG DCA FIPFOP TAD INTEG JMS OCTDBL DCA DECICH TAD REM JMS DIV -144 DCA REM TAD INTEG JMS OCTDBL DCA DECICH+1 TAD REM JMS DIV -12 TAD (60 DCA DECICH+3 TAD INTEG JMS OCTDBL DCA DECICH+2 TAD DECICH CLL RTL RTL RTL TAD DECICH+1 DCA NOBLK1 TAD DECICH+2 CLL RTL RTL RTL TAD DECICH+3 DCA NOBLK2 JMP I OCTDEC OCTDBL, 0 SZA JMP ODBL2 TAD FIPFOP SZA CLA TAD (60 JMP I OCTDBL ODBL2, DCA FIPFOP TAD FIPFOP TAD (60 JMP I OCTDBL DIV, 0 DCA DITEMP TAD I DIV DCA DITEM2 ISZ DIV DCA INTEG TAD DITEMP CLL /FIX BUG TAD DITEM2 SNL JMP .+3 ISZ INTEG JMP .-5 CIA TAD DITEM2 CIA JMP I DIV DATEMP, 0 NME1, 0 NME2, 0 NME3, 0 NME4, 0 NME5, 0 NOBLK1, 0 NOBLK2, 0 0 DA1, 0 DA2, 0 DA3, 0 DA4, 0 0 0 REM, 0 INTEG, 0 FIPFOP, 0 DECICH, 0 0 0 0 DITEMP, 0 DITEM2, 0 PAGE XPRINT, 0 /ENTER WITH AC=-N CHARS DCA XPRCT TAD I XPRINT /WILL RETURN WHEN COUNT OVERFLOWS DCA XPRPTR /@ (00) GOES TO SPACE ISZ XPRINT XPRNEX, TAD I XPRPTR CLL RTR RTR RTR JMS UTRM ISZ XPRCT /HAS COUNT OVERFLOWED SKP JMP I XPRINT /YES, RETURN TAD I XPRPTR JMS UTRM ISZ XPRPTR ISZ XPRCT /HAS COUNT OVERFLOWED JMP XPRNEX /NO, CONTINUE JMP I XPRINT /YES, RETURN UTRM, 0 AND (77 SZA /WE CONVERT 00 TO 40 - @ TO SPACE TAD (-40 SPA /SKIP IF IT IS 240-277 TAD (100 /IT IS 300-337 TAD (240 /EVERBODY WAS THIS LOW CALL, JMS OPUTCH JMP I UTRM OPUTCH, 0 /OUTPUT A CHARACTER DCA OCHAR TAD OCHAR TAD (-240 SZA JMP .+3 ISZ SPCT JMP I OPUTCH TAD (240-215 SNA CLA DCA SPCT TAD SPCT SNA JMP NOBLOG CIA DCA SPCT TAD (240 JMS OUT ISZ SPCT JMP .-3 NOBLOG, TAD OCHAR JMS OUT JMP I OPUTCH OUT, 0 /OUTPUT CHAR TO PROPER DEVICE ISZ WHICH JMP OUTXX2 JMS TYPE CMA OUTXX1, DCA WHICH KRS /CHECK FOR CONTROL C... TAD (100-"C /CHECK FOR C AND O SNA JMP MEXIT /HAD CTRLC, QUIT TAD ("C-"O / O CHECK SNA CLA JMP MEXIT /WAS O, QUIT JMP I OUT OUTXX2, JMS I PTOPUT /NORMALLY OPUTC, CHANGE FOR KV OPTION JMP OUTXX1 PTOPUT, OPUTC /MAY BE CHANGED IF KVOPTION... TYPE, 0 /OUTPUT TO TTY TLS TSF JMP .-1 CLA JMP I TYPE NMATCH, CLA CMA /WE DIDNT FIND ANY MATCHING FILES DCA WHICH TAD (-21 JMS XPRINT FNF JMP MEXIT SYNTAX, CLA CMA DCA WHICH TAD (-16 JMS XPRINT SYN MEXIT, /RETURN TO MONITOR... CIF CDF 0 JMP I .+1 7605 FNF, TEXT /FILE(S) NOT FOUND/ SYN, TEXT /ILLEGAL SYNTAX/ /KEEP EVEN NO. CHRS XPRCT=.-1 /BECAUSE WE USE TERMINATOR FOR STORAGE XPRPTR, 0 OCHAR, 0 SPCT, 0 WHICH, 0 OCRLF, 0 /OUTPUT CR-LF TAD (215 JMS OPUTCH TAD (212 JMS OPUTCH JMP I OCRLF PAGE /DIRECTORY SEARCH ROUTINE /DSFLD= /FIELD OF THIS PROGRAM DIRSRH, 0 SNA /SET MASK POINTER & SEARCH FROM DIRECTORY BEGINNING? JMP DSLABB /NO. DCA DSMSK1 /YES--SAVE POINTER. DCA DSFBLK /ZERO FREE BLOCK ACCUMULATOR. IAC JMP DSREAD /GO READ FIRST BLOCK OF DIRECTORY. DSLABB, TAD DSMSK1 SZA CLA /THEN DO WE HAVE A MASK? JMP DSLABA /YES. CMA /NO--TAKE ERROR EXIT. JMP I DIRSRH DSLABC, TAD I DSMSK1 /SET ENTRY POINTER INCREMENT TO ADVANCE PAST AN ENTRY. CIA TAD (5 DCA DSINC DSLABA, ISZ DSCT /ANY MORE ENTRIES IN THIS BLOCK? JMP DSNEXT /YES--GET NEXT ENTRY. CMA /NO. DCA DSCT /RESET COUNTER TO OVERFLOW. TAD I DSLINK SZA CLA /IS THERE ANOTHER BLOCK? (CHECK DIRECTORY LINK.) JMP DSREAD /YES--GO READ NEXT BLOCK. DCA DSMSK1 /NO--ZERO MASK POINTER--HAVE FINISHED WITH IT. TAD DSFBLK /ERROR RETURN (CALL+1) WITH # OF FREE BLOCKS. JMP I DIRSRH DCA I DSMSK1 /SUPPLY TO CALLING PROGRAM. DSNEXT, TAD DSENTP TAD DSINC DCA DSENTP /ADVANCE ENTRY POINTER TO NEXT ENTRY. TAD I DSENTP SZA CLA /IS THIS AN EMPTY FILE ENTRY? JMP DSLABD /NO. IAC /YES. TAD DSENTP DCA DSTEMP TAD I DSTEMP CIA TAD DSFBLK /ACCUMULATE # OF FREE BLOCKS. DCA DSFBLK CLA CLL CML RTL DCA DSINC /SET INCREMENT TO ADVANCE OVER AN EMPTY FILE. TAD OPTF /GET /F OPTION WORD. SZA CLA /IS OPTION /F SET? JMP DSLABA /YES--IGNORE EMPTY FILE. TAD OPTE /NO--GET /E OPTION WORD. SNA CLA /IS OPTION /E SET? JMP DSLABA /NO--IGNORE EMPTY FILE. JMP DSNEXI /YES--TAKE NORMAL EXIT TO OUTPUT EMPTY FILE. DSLABD, TAD I DSADDW CMA /DON'T INCREMENT IN TAKING NEG. SO CAN USE EXISTING CONS STANT (5. TAD DSENTP TAD (5 DCA DSTEMP /SET UP POINTER TO FILE LENGTH. TAD I DSTEMP /GET FILE LENGTH. SNA CLA /IS THIS A TEMPORARY FILE ENTRY? JMP DSLABC /YES--IGNORE ENTRY. TAD DSENTP /NO--"DOES ENTRY MATCH WILD CARD" ROUTINE FOLLOW WS. DCA DSENP /GET AN ENTRY POINTER IN THE ACTIVE POINTER. IAC TAD DSMSK1 DCA DSNMFM /NOW POINTS TO MASK WORD. TAD I DSNMFM /GET MASK WORD DCA DSMASK ISZ DSNMFM /ADVANCE TO POINTER TO FIRST NAME FORM WORD. TAD (-4 DCA DSCT2 /SET COUNTER TO LOOP FOUR TIMES. DSLOOP, TAD DSMASK SNA /IS MASK ZERO? JMP DSES /YES--FULL WILD CARD--IT DOES MATCH. CLL RAL SNL /IS FIRST CHAR. WILD? JMP DSLABE /YES. CLL RAL /NO. DCA DSMASK /RESTORE MASK WORD. TAD (7700 /PRESERVE FIRST CHAR. DSTWO, SZL /IS SECOND CHAR. WILD? TAD (77 /NO--PRESERVE SECOND CHAR. DCA DSMSKW /YES--SAVE MASKING WORD. TAD I DSENP AND DSMSKW /MASK OFF ENTRY WORD CIA TAD I DSNMFM SZA CLA /ARE THEY EQUAL? JMP DSLABC /NO--IT DOES NOT MATCH--IGNORE ENTRY. DSMSK0, ISZ DSENP /ADVANCE ACTIVE ENTRY POINTER. ISZ DSNMFM /ADVANCE NAME FORM POINTER. ISZ DSCT2 /FINISHED LOOP? JMP DSLOOP /NO--CONTINUE. DSES, TAD I DSADDW /YES--THIS ENTRY DOES MATCH. CIA TAD (5 DCA DSINC /SET ENTRY INCREMENT TO ADVANCE OVER PERMANENT FILE. DSNEXI, TAD DSENTP /GET POINTER TO THIS ENTRY. ISZ DIRSRH /ADVANCE TO NORMAL EXIT (CALL+2). JMP I DIRSRH DSLABE, CLL RAL DCA DSMASK SZL JMP DSTWO+1 JMP DSMSK0 / / DSTEMP, 0 /TEMPORARY STORAGE. DSMSK1, 0 /MASK-1 POINTER, INITIALLY =0. DSLINK, IBUFF+2 /SEG. LENGTH POINTER. DSFBLK, 0 /FREE BLOCK ACCUMULATOR. DSINC, 0 /INCREMENT VALUE FOR ENTRY POINTER. DSCT, -1 /COUNTER FOR ENTRIES PER BLOCK (INITIALLY =-1). DSENTP, 0 /ENTRY POINTER. DSENP, 0 /ACTIVE ENTRY POINTER--IT ADVANCES FOR COMPARING. DSNMFM, 0 /POINTER TO NAME FORM--I.E. SOUGHT CHARACTER IN NAME. DSMASK, 0 /MASK WORD WHOSE BITS MASK OFF WILD CHARACTERS. DSCT2, 0 /COUNTER FOR COMPARE LOOP. DSMSKW, 0 /ACTUAL MASK WORD USED TO MASK OFF WILD CHARS. DSADDW, IBUFF+4 /POINTER TO NEG. # OF ADDITIONAL WORDS. OPTE, 0 OPTF, 0 PAGE DSREAD, JMS BKIN /READ A BLOCK. JMP DSUSR6 /EOF ENCOUNTERED--SHOULD NOT OCCUR => BAD DIR. OR FILE L LENGTH. TAD I DSNENT /GET ENTRY COUNTER. DCA DSCT DCA DSINC /CLEAR ENTRY POINTER INCREMENT. IAC TAD DSADW2 DCA DSENTP /NOW POINTS TO FIRST ENTRY IN THIS BLOCK. TAD I DSADW2 /GET NEG. # OF ADDITIONAL WORDS PER ENTRY. JMP DSNEXT-1 DSNENT, IBUFF /POINTER TO THE NUMBER OF ENTRIES IN THIS BLOCK. DSADW2, IBUFF+4 /POINTER TO NEG. # OF ADDITIONAL WORDS. DSUSR6, CIF 10 JMS USR 7 6 /BLOCK INPUT ROUTINE. /TEMPORARY DEFINITIONS FOR ASSEMBLY LISTING BUFIFD=1 IBUFF=3200 FILTAB=NFILE INHAND=6600 I2PAGE=1 USR=200 /THE FOLLOWING ARE ASSEMBLY TIME PARAMETERS: /BUFIFD= /FIELD OF INPUT BUFFER. /IBUFF= /INPUT BUFFER ADDRESS. /FILTAB= /POINTER TO INPUT FILE TABLE. /INHAND= /LOCATION (IN FIELD 0) FOR INPUT HANDLER. /I2PAGE= /0 => ONLY ONE PAGE HANDLER ALLOWED, / /1 => SPACE AVAILABLE FOR TWO PAGE HANDLER. /USR= /ACCESS TO "USR" -- / /IF USR WILL BE RESIDENT THEN USR=200 / /ELSE USR=7700. / / /THE FOLLOWING MONITOR "USER ERROR" MESSAGES ARE POSSIBLE: / "USER ERROR 4 AT XXXX" => NON-FILE STRUCTURED INPUT DEVICE. / "USER ERROR 5 AT XXXX" => NO SUCH DEVICE OR NO SPACE / FOR TWO PAGE HANDLER. / "USER ERROR 6 AT XXXX" => DEVICE HANDLER EOF OR INPUT ERROR / /THIS PROG. WILL WORK IN ANY FIELD BUT MUST BE CALLED FROM WITHIN THE SAME FIELD D. BKIN, 0 SZA CLA /RESET INPUT FILE TABLE? JMP BKISRT /YES--START OVER. TAD BKICT /EXAMINE BLOCK COUNTER. SNA CLA /MORE BLOCKS IN THIS FILE? JMP BKINF /NO--GET NEXT FILE. BKINBK, ISZ BKIN /YES--MORE BLOCKS, ADVANCE TO RETURN TO CALL+2 CIF 0 /HANDLERS AR ALWAYS IN FIELD 0. JMS I BKIHND /CALL HANDLER TO READ. BUFIFD 10+200 /# BLOCKS & FIELD OF BUFFER. IBUFF /ADDRESS OF BUFFER. BKINM, 0 /BLOCK # TO BE READ. JMP BKIER6 /HANDLER ERROR. ISZ BKINM /ADVANCE BLOCK #. ISZ BKICT /COUNT BLOCK JUST READ. NOP /SKIPS AT END OF FILE. JMP I BKIN /EXIT. BKISRT, TAD BKIFT /START OVER WITH INPUT FILES. DCA BKIFPT /RESET FILE TABLE POINTER. BKINF, TAD BKIB /NEXT FILE SET UP. DCA BKIHND /RESET LOCATION FOR INPUT HANDLER IN USR FETCH. TAD I BKIFPT /GET DEVICE # FROM INPUT FILE TABLE. SNA /ANY MORE FILES? JMP I BKIN /NO--MORE FILES--TAKE ERROR EXIT "CALL+1". CIF 10 /USR ACCESS IS ALWAYS IN FIELD 1. JMS USR 1 /FETCH HANDLER IF ABSENT & GET ENTRY POINT. BKIHND, INHAND&7600+I2PAGE/SPECIFY LOCATION FOR INPUT HANDLER--BECOMES /ENTRY TO HANDLER. JMP BKIER5 /FETCH ERROR. TAD I BKIFPT AND (7760 /GET # BLOCKS IN THIS FILE. SNA JMP BKIER4 /MUST BE FILE STRUCTURED DEVICE. CLL RTR RTR TAD (7400 /COMPLETE THE NEGATIVE # OF BLOCKS. DCA BKICT /SET BLOCK COUNTER. ISZ BKIFPT /ADVANCE INPUT TABLE POINTER. TAD I BKIFPT /GET STARTING BLOCK OF FILE. DCA BKINM /SET UP FOR HANDLER CALL. ISZ BKIFPT /ADVANCE TO NEXT FILE IN INPUT TABLE. JMP BKINBK /GO INPUT THE NEXT BLOCK. BKIER6, CLA IAC /SET FOR USR 'USER ERROR' CALL BKIER5, IAC BKIER4, TAD (4 DCA BKIER CIF 10 JMS USR 7 /USR 'USER ERROR' MESSAGE. BKIER, 5 /ERROR NUMBER. BKICT, 0 /BLOCK COUNTER, INITIALLY = 0. BKIFT, FILTAB /CONSTANT POINTER TO INPUT FILE TABLE. BKIFPT, FILTAB /ACTIVE POINTER TO INPUT FILE TABLE. BKIB, INHAND&7600+I2PAGE/LOCATION FOR INPUT HANDLER FOR USR FETCH. PAGE /ROUTINE TO SETUP FOR PRINTING HEADER FROM PARAMETER /BLOCK. SIGNALED BY /H OPTION FOR ALL HEADER INFO /AND /U OPTION FOR JUST USER-DEVICE-NAME. HEADER, STA DCA SLHFL /SET /H FLAG UDEVN, STA DCA SLUFL /AND /U FLAG JMP I (SLSHCR /RETURN SLHFL, 0 SLUFL, 0 /COME HERE TO CHECK HEADER OPTION HEADR, ISZ SLUFL /ANY HEADER OPTIONS? JMP I (CLRBUF /NO:GO ON TO LOOKUP STUFF IN DIRECTORY IAC JMS BKIN /JUST TO LOAD HANDLER NOP TAD (6 /NOW TO GET BLOCK 6 DCA BKINM /WANT TO READ BLOCK 6 JMS BKIN /READ IT NOP ISZ I (IBUFF+2 /SKIPS IF PARAMETER BLOCK PRESENT JMP I (CLRBUF /NO PARAM BLOCK=IGNORE OPT. JMS I (OCRLF TAD (-4 /PRINT THE UDNAME JMS I (PARAMP IBUFF+100 TAD I (IBUFF+104 /VOLUME I.D. JMS I (OCTDEC /CONVERT TO DECIMAL TAD (-12 JMS I (XPRINT VOLUME TAD (-4 JMS I (PARAMP /PRINT IT DECICH JMS I (OCRLF /NEW LINE ISZ SLHFL /PRINT IT ALL? JMP PARAME /NO: TAD (-177 JMS I (PARAMP /AND DESCRIPTIVE LABLE IBUFF+200 JMS I (OCRLF /NEW LINE ISZ I (IBUFF+7 /SKP IF SYSTEM PRESENT JMP PARAME /DONE. TAD I (IBUFF+105 /SYSTEM TYPE CIA /MAKE POS. CLL RAL /*2 WORDS PER ENTRY TAD (TYPTAB /INDEX INTO NAME TABLE DCA SLUFL /A GOOD TEMP TAD I SLUFL /PICK UP NAME POINTER DCA .+4 ISZ SLUFL /TO #CHARS TAD I SLUFL /-#CHARS JMS I (XPRINT 0 TAD (-6 JMS I (XPRINT MARK TAD I (IBUFF+106 /VERSION # JMS I (OCTDEC /CONVERT TAD (-4 JMS I (PARAMP /PRINT IT DECICH TAD (". JMS I (OPUTCH /AND "." TAD I (IBUFF+107 /RELEASE NUMBER JMS I (OCTDEC /CONVERT TAD (-4 JMS I (PARAMP /PRINT DECICH TAD (-7 JMS I (XPRINT SYSTEM JMS I (OCRLF PARAME, JMS I (OCRLF JMP I (CLRBUF /AND GO ON TYPTAB=. SYS0;-1 SYS1;-4 SYS2;-4 SYS3;-5 SYS4;-13 SYS0, 0 SYS1, TEXT PS/8 SYS2, TEXT OS/8 SYS3, TEXT OS/12 SYS4, TEXT DECSYSTEM-8 SYSTEM, TEXT SYSTEM MARK, TEXT MARK PAGE DISPAT, 0 /DISPATCH CIA DCA DISTEM SKP DISLOP, ISZ DISPATCH TAD I DISPATCH ISZ DISPATCH SMA JMP .+3 CLA JMP I DISPATCH TAD DISTEM SZA CLA JMP DISLOP TAD I DISPATCH DCA DISPATCH JMP I DISPATCH DISTEM, 0 LPTNA, CLA CMA /LPT NOT AVAILABLE DCA WHICH TAD (-22 JMS XPRINT LPNA JMP NAVAL+3 DEVNA, CLA CMA /SPECIFIED DEVICE NOT AVAIL DCA WHICH TAD (-4 JMS XPRINT DEV1 NAVAL, TAD (-16 /GATHERING POINT FOR THE REST OF THE MESSAGE JMS XPRINT LPNA+2 JMP MEXIT NODIR, CLA CMA /SPECIFIED DEVICE NOT DIR STRUCT DCA WHICH TAD (-11 JMS XPRINT DIRY JMP NAVAL TTYNA, CLA CMA /TTY NOT AVAIL????? HOW?, OH WELL, BAD BUILD... DCA WHICH TAD (-4 JMS XPRINT TTYDEV JMP NAVAL TTYDEV, TEXT /TTY / LPNA, TEXT /LPT@ NOT AVAILABLE/ DIRY, TEXT /DIRECTORY/ NFILE, 7641 1 0 /MUST BE ZERO--TERMINATES INPUT FILE TABLE. /THE FOLLOWING IS USED BY THE OUTPUT ROUTINE. /IT COMES HERE IN CASE OUTPUT CANNOT BE OPENED ON FIRST TRY. OFAIL, TAD I (7600 AND (7760 SNA CLA /SKIP IF NOT INDEFINITE REQUEST. ERROR1 /OUTPUT FILE PROBABLY TOO LARGE. TAD I (7600 AND (17 DCA I (7600 JMP I (OUENTR /TRY INDEFINITE. /OUTPUT SOME STUFF FROM PARAMETER BLOCK. /RETURNS WHEN MAX CHARS PRINTED OR Z. /CALL: TAD (-NUMCHRS / JMS I (PARAMP / BUFFADD PARAMP, 0 DCA DISPAT /A GOOD TEMP TAD I PARAMP /GET BUFFER ADD DCA DISTEM /ANOTHER GOOD TEMP ISZ PARAMP /POINT TO RETURN PARAM1, TAD I DISTEM /GET AN ASCII CHAR TAD (-"Z+100 /CHECK FOR Z SNA JMP I PARAMP /DONE. TAD ("Z-100 /GET CHAR BACK SZA /DON'T PRINT 0'S JMS I (OPUTCH /OUTPUT IT ISZ DISTEM /NEXT CHAR ISZ DISPAT /DONE? JMP PARAM1 /NO: LOOP FOR NEXT JMP I PARAMP /YES. VOLUME, TEXT VOLUME PAGE / SORT SUBROUTINE FOR FIXED NUMBER OF RECORDS. / RECLEN = RECORD LENGTH. / SORLEN = NUMBER OF WORDS PER RECORD TO BE SORTED ON. / SORTL = LOC. CONTAINING 1 ST. WORD OF 1ST. RECORD. / SORTH = LOC+1 CONTAINING LAST WORD OF LAST RECORD. SORT, 0 TAD SORLEN CIA TAD RECLEN SPA CLA HLT / SORLEN > RECLEN SET, TAD SORTL DCA REC1 / SET UP CURRENT RECORD POINTER. TAD SORTL TAD RECLEN NOP DCA REC2 / SET UP CURRENT RECORD+1 POINTER. TAD SORTH DCA BUFFA / SET UP WORK AREA. TAD RECLEN CIA DCA MRELEN / SET UP RECORD ELEMENT COUNTER. JMP GEREDY TAD SORTL CIA TAD REC1 SPA CLA JMP SET GEREDY, TAD REC1 / COPY CURRENT RECORD ADDRESSES. DCA REC1+1 TAD REC1 TAD SORST DCA REC1 TAD REC2 DCA REC2+1 TAD REC2 TAD SORST DCA REC2 TAD SORLEN CIA DCA ZERCOT COMPR, TAD I REC1 /COMPARE RECORD AND RECORD+1. CIA CLL TAD I REC2 SNA JMP ZERO / ELEMENTS WITHIN RECORDS ARE =. SZL CLA JMP OK / RECORDS ARE IN THE RIGHT ORDER. TAD MRELEN / RECORDS ARE IN THE WRONG ORDER. DCA COUNTA / CHANGE ROUND RECORD AND RECORD+1. CHANGE, JMS RESET TAD I REC1 DCA I BUFFA ISZ REC1 ISZ BUFFA ISZ COUNTA JMP CHANGE+1 TAD MRELEN TAD REC1 DCA REC1 TAD MRELEN TAD BUFFA DCA BUFFA TAD MRELEN DCA COUNTA MOOV, TAD I REC2 DCA I REC1 ISZ REC2 ISZ REC1 ISZ COUNTA JMP MOOV TAD MRELEN TAD REC1 DCA REC1 TAD MRELEN TAD REC2 DCA REC2 TAD MRELEN DCA COUNTA COPIE, TAD I BUFFA DCA I REC2 ISZ REC2 ISZ BUFFA ISZ COUNTA JMP COPIE TAD MRELEN TAD REC2 DCA REC2 TAD MRELEN TAD BUFFA DCA BUFFA TAD REC1 DCA REC2 TAD REC1 TAD MRELEN DCA REC1 JMP GEREDY-5 ZERO, ISZ REC1 / MOVE POINTER TO NEXT RECORD ELEMENTS. ISZ REC2 ISZ ZERCOT / (WITHIN SORT KEY) JMP COMPR OK, JMS RESET / RECORDS ARE IN THE RIGHT ORDER, TAD REC2 / MOVE TO NEXT PAIR. DCA REC1 TAD REC2 TAD RECLEN DCA REC2 TAD SORTH CIA CLL TAD REC2 SZL CLA JMP I SORT JMP GEREDY RESET, 0 / RESET RECORD POINTERS. TAD REC1+1 DCA REC1 TAD REC2+1 DCA REC2 JMP I RESET BUFFA, 0 MRELEN, 0 REC1, 0 0 REC2, 0 0 COUNTA, 0 ZERCOT, 0 0 RECLEN, 0 SORLEN, 4 SORTL, 0 SORTH, 0 SORST, 0 PAGE /ASCII I/O FOR PS-8 /DEFINITIONS REQUIRED FOR CHARACTER I/O ROUTINES. OUTBUFF=3600 ODEV=7200 /WHERE INPUT HANDLER GOES ERROR1=HLT /WHAT TO DO WHEN AN ERROR IS DETECTED. /DELIVERS A CHARACTER TO THE OUTPUT FILE. OUTPUT FILE NAME /MUST HAVE BEEN DEFINED PREVIOUSLY!! / Z WILL CLOSE OUTPUT FILE. /CALLED BY: / TAD CHAR / IOF /SEE NOTE AT IGETC ABOVE. / CDF / CIF 10 / JMS I (OPUTC / RETURN (ACC=0) IFNDEF XLSIO XLIST XLSIO OPUTC, 0 DCA LAST /THIS CODE IS NOT NEEDED IN THIS CASE IFNZRO 0 < /SEE ALSO LABEL ODONE CHANGE RDF TAD CDFCIF DCA ODONE > CDF CIF 10 TAD LAST OL02, DCA I OPNTR TAD OUTINH SNA CLA /SKIP IF OUTPUT ENTERED. JMP OOPEN OL01, ISZ OPNTR TAD I OPNTR SMA /SKIP WHEN 3 CHARACTERS SAVED. JMP OEXIT DCA OPNTR /RESTORE POINTER. TAD OPNTR+3 CLL RTL;RTL AND O7400 TAD OPNTR+1 DCA I OCA ISZ OCA TAD OPNTR+3 CLL RTR;RTR;RAR /LEFT-SHIFT 8. AND O7400 TAD OPNTR+2 DCA I OCA ISZ OCA O7400, 7400 /IN CASE OCA PASSES THRU 0. ISZ OWC /SKIP IF BUFFER FULL. JMP OEXIT ISZ OBLWC /SKIP IF OUTPUT FILE TOO LARGE! SKP ERROR1 CIF JMS I OUHAND 4210 OUTP, OUTBUFF OUTBLK, 0 /MUST BE FILLED BY 'OOPEN'. ERROR1 ISZ OUTBLK JMS ORESET O7600, OEXIT, 7600 TAD LAST TAD (-232 SZA CLA /SKIP IF Z RECIEVED. JMP ODONE /CLOSE THE OUTPUT FILE. TAD OUTBLK CIA DCA OUBLK /SAVE -BLOCK. JMS OPUTC /PACK WITH 0'S. TAD OUTBLK TAD OUBLK SNA CLA /SKIP WHEN LAST ONE WRITTEN. JMP .-4 TAD OULENGTH CIA /NOW HAVE +LENGTH. TAD OBLWC /GET -LENGTH+N DCA OBLWC TAD I O7600 JMS I (200 4 /CLOSE OU7601, 7601 OBLWC, 0 /COUNTS BLOCKS AVAILABLE. ERROR1 DCA OUTINH /MARK OUTPUT FILE CLOSED. CDFCIF, CDF CIF JMP I RETURN /TO CALL+1. ODONE, CIF CDF 10 /FIXED UP FOR SPECIAL CASE JMP I OPUTC IFNDEF O2PAGE OOPEN, TAD OU7601 DCA OUBLK TAD (11 OL03, IAC DCA OUHAND-1 TAD (ODEV+O2PAGE DCA OUHAND TAD I O7600 SNA /SKIP IF OUTPUT POSSIBLE. ERROR1 JMS I (200 12 /CHECK HANDLER, OR FETCH IT. OUHAND, ODEV+O2PAGE ERROR1 /HUH? TAD .-2 SNA CLA /SKIP IF NOW IN CORE. JMP OL03 /TRY TO LOAD IT. OUENTR, TAD I O7600 JMS I (200 3 /ENTER OUTPUT FILE. OUBLK, 7601 OULENG, 0 JMP I (OFAIL /CAN'T ENTER IT. TAD OUBLK DCA OUTBLK TAD OULENGTH DCA OBLWC JMS ORESET ISZ OUTINH JMP OL01 /RESET POINTERS. ORESET, 0 TAD OPNTR+4 DCA OPNTR TAD O7600 DCA OWC TAD OUTP DCA OCA JMP I ORESET OPNTR, .+1 0 /SIMILAR TO IPNTR+1 ETC. 0 0 OPNTR+1 /SEE IPNTR+4 FOR WARNING! LAST, 0 /CONTAINS LAST CHAR RECIEVED. OWC, -200 /" OCA, OUTBUFF /" RETURN, 7605 /RETURN ADDRESS FOR RECURSIVE OPUTC. /(RETURN TO MONITOR) OUTINH, 0 /0 WHEN NO OUTPUT FILE IN PROGRESS. PAGE XLIST 0 /RE ENABLE LISTING /COPYRIGHT BY DIGITAL EQUIPMENT CORPORATION 1969 /BASIC CHARACTER GENERATOR /WRITTEN BY MURRAY RUBEN AS PART OF THE KV8/I SOFTWARE. /NOTE: ROUTINE IS 332 DECIMAL LOCATIONS LONG. /(2 2/3 PAGES) IFNDEF XLSKV8 XLIST XLSKV8 IFNZRO KV8OPT < *2000 DSPY, 0 /CALL WITH ASCII CHAR IN ACCUMULATOR JMS I SRCHI /IS IT A SEARCH CHARACTER? TAD I SAVE2 /CHECK FOR CONTROL CHAR TAD M240 SPA CLA JMP I DSPY /IGNORE CONTROL CHAR (NO ECHO) TAD I SAVE2 JMS OUTCHM /OUTPUT TO DISPLAY DSPYI, JMP I DSPY /EXIT WITH AC=0 /THE FOLLOWING IS A "SHORT" DATA AREA: M240, -240 SAVE2, SAVE1 /ANOTHER TEMPORARY STORAGE AREA. SRCHI, SEARCH M7, -7 M14, -14 TOP, 516 /TOPMOST LINE OF THE SCREEN. /ROUTINE -RESET- ACCOMPLISHES THE "VERTAB" FUNCTION (CTRL/K). VERTAB, TAD TOP /ERASE SCREEN, RESET INTGEGRATORS AND CPR TO TOP LEFT 6066 /EXECUTE DCA Y0 /SET Y TO TOP CR, TAD Y0 TAD M14 DCA Y0 TAD MARGIN XCUTE, DCA X0 TAD M240 JMP DSPYI-1 /SET INTEGRATORS TO "MARGIN". SYNC, TAD M7 /"SYNCHRONIZE" A STABLIZING FUNCTION . TAD X0 JMP XCUTE /VARIABLES USED BY CHARACTER GENERATOR X0, -400 /X CHARACTER POSITION REGISTER Y0, 512 /Y CHARACTER POSITION REGISTER A, 0 /CONTROL WORD B, 0 /MASK WORD C, 0 /MASK POINTER H, 0 /HALFWORD SWITCH /CONSTANTS C7, 7 C77, 77 CEX, 400 SAR1, SAR MASKS, MASK0-1 /THIS IS THE ROUTINE WHICH DEALS WITH THE "MASK" AND /"DISPATCH" CONTROL WORDS FOR THE ACTUAL DETERMINATION /AND EXECUTION OF THE APPROPRIATE VECTOR STROKES TO /BE DISPLAYED ON THE SCOPE..... OUTCHM, 0 /DISPLAY CHARCTER. ENTER WITH ASCII 240-337 AND C77 /MASK TO 6 BITS CLL RAL /*2 TAD SAR1 /ADD DISPATCH DCA A TAD I A /THIS IS MASK WORD AND C7 /MASK OFF MASK BITS CLL RAL /*2 DCA B TAD B CLL RAL /*4 TAD B /*6 NOW TAD MASKS /6 TIMES MASK + MASK HEAD POINTER DCA C /PTR FOR MASK ADDRESSES TAD I A CLL RAR DCA B /SETS INTENSIFY BLANKING BITS, FIRST ALWAYS BLANKED ISZ A TAD I A DCA A /RETRIEVE CONTROL WORD DCA H /SETS LEFT HALF TAD X0 TAD C7 DCA X0 /CHAR ADVANCE VA, TAD H CIA DCA H /RESET HALFWORD SWITCH ISZ H ISZ C /ADVANCE PTR ON ZERO H TAD A SNA /TEST NEXT CONTROL BIT JMP I OUTCHM /ZERO MEANS ALL VECTORS WERE EXECUTED, SO EXIT CLL RAL DCA A /NEXT CONTROL BIT IN LINK SNL JMP VA /NOT AN EXECUTION TAD C6064 /INITIALIZE VOUT DCA VSTATE TAD H /0 IF RIGHT HALF, 1 IF LEFT HALF CLL RAR /INTO LINK TAD I C /GET MASK ADDRESS SNL JMP .+4 /R.H. CLL RTR RTR RTR /L.H. DCA I SAVE2 TAD I SAVE2 RTR RAR AND C7 TAD X0 /ADD X MASK TO CPR JMS VOUT /LOAD X ABSOLUTE TAD I SAVE2 AND C7 TAD Y0 /ADD Y MASK TO CPR JMS VOUT /LOAD Y ABSOLUTE TAD B CLL RAL DCA B /RETRIEVE NEXT BLANKING BIT INTO LINK RAL /AND THEN INTO BIT 11 TAD CEX /EXECUTE ABSOLUTE (VISIBLE) VECTOR JMS VOUT JMP VA /BACK FOR MORE VECTORS /THIS IS THE ROUTINE WHICH ACTUALLY EXECUTES THE /STROKES, POINT DISPLAYS, AND OTHER FUNCTIONS FOR /THE KV8/I CONTROLLER... /DISPLAY OUTPUT AUTO SEQUENCING ROUTINE: VOUT, 0 6071 JMP .-1 VSTATE, 6064 /AUTO SEQUENCED INSTRUCTION ISZ VSTATE /SEQUENCE CLA JMP I VOUT C6064, 6064 /INITIALIZED TO LOAD X /THE FOLLOWING ROUTINE EXECUTES THE "TAB" FUNCTION /OF MOVING ALONG THE LINE TO THE NEXT TAB STOP. /TAB STOPS ARE LOCATED EVERY 10 SPACES ALONG /THE LINE FROM THE LEFT MARGIN. TAB, TAD TABHD /ADVANCE X0. DCA A TAB1, ISZ A /TO NEXT TAB STOP. TAD I A SNA /END OF LIST=END OF LINE SO DO CRLF. JMP CR CIA TAD X0 /TEST X0 WITH THE TAB STOP LIST. SMA CLA JMP TAB1 /NOT BIG ENOUGH SO TRY AGAIN. TAD I A /O.K. SET THE TAB AND RESET INTEGRATORS. JMP XCUTE TABHD, TABS-1 /HEAD OF TAB STOP TABLE.. /THE FOLLOWING IS THE ACTUAL "TABS STOP" LIST: TABS=. MARGIN, -440 / /LEFTMOST TAB IS SPECIAL LEFT MARG FOR THIS PROG -252 -144 -36 50 156 264 0 /ZERO ENDS THE LIST.. /THE FOLLOWING "SEARCH" ROUTINE CHECKS THE INPUT /ASCII CODE AGAINST THE "ACTIVE" CONTROL CHARACTERS. SEARCH, 0 /SEARCH ROUTINE. DCA SAVE1 /SAVE THE INPUT ASCII CHARACTER TAD SRCH3 DCA PTR SRCH2, ISZ PTR /FOLLOW ALONG DOWN THE CHARACTER TABLE. TAD I PTR /BRING IN A LIST ELEMENT SNA JMP I SEARCH /END OF TABLE FOUND AND NO MATCH! CIA /COMPLEMENT TO TEST. ISZ PTR TAD SAVE1 /NOW TEST AGAINST THE "CHAR". SZA CLA JMP SRCH2 /NO MATCH FOUND SO TRY AGAIN! TAD I PTR /"MATCH FOUND" !! DCA SEARCH /DO DOUBLE INDIRECT JUMP JMP I SEARCH /FROM DLIST POINTER. /CONSTANTS FOR THE ABOVE PTR, 0 /TEMP POINTER CELL USED IN "SEARCH" ROUTINE. SAVE1, 0 /TEMP STORAGE AREA. SRCH3, DLIST-1 /BEGINNING OF THE CONTROL CHAR. TEST LIST. DLIST=. /TABLE OF ACTIVE CONTROL CHARACTERS. 215 CR /CARRIAGE RETURN 213 VERTAB /VERTAB FUNCTION OF ERASE AND RESET INTEGRATORS. 377 DSPYI /RUB OUT (IGNORED) 375 DSPYI /ALT MODE KEY (IGNORED) 211 TAB /HT "Z-100 MEXIT /CTRL Z GOES TO MEXIT 237 SYNC /SYNC (CTRL/SHIFT/O) FUNCTION TO STABLIZE. 0 /ZERO ENDS THE LIST.... /THE FOLLOWING PARTS ARE THE CHARACTER TABLES FOR THE CHARACTER /GENERATOR . /CHARACTER MASK COORDINATES MASK0, 0301 /D,J,5,&,%, 2143 4145 2705 0747 0301 MASK1, 0701 /L,U,V,W,X,Y,I,T,N,M,0,1,(,), 0706 2447 2724 2141 0147 MASK2, 0141 /2,S,4,9,7,Z,$,/, ,<,> 0747 4404 0747 0141 2127 MASK3, 0424 /A,C,E,F,G,H,K,0,Q,R,P,3,6,8,L,B 3444 4147 0701 4144 2404 MASK4, 2622 / ,B.A.,-,+,* 4305 4503 0426 4404 MASK5, 4525 /@,#,= 0503 2343 4721 2707 0141 MASK6, 0627 /",',;,:,?,!,,, 2525 4524 2323 1121 2147 /PART OF GETTING OUT DEVICE STUFF SETKV8, TAD (DSPY DCA PTOPUT DCA N /WIDE OPTION IS DEFAULT TAD ("K-100 JMS I (DSPY /CLEAR SCOPE JMP LABGY *4000 /PUT HERE, TO SAVE A BLOCK ON SYS DEV... SAR=. /CHARACTER DISPATCH TABLE 7745 /@ 6347 5603 /A 4760 7703 /B 2175 7003 /C 0170 7700 /D 3551 5603 /E 5170 5403 /F 5160 7603 /G 0176 5203 /H 4760 5201 /I 1156 7000 /J 5404 6503 /K 6172 6003 /L 0070 7401 /M 3304 7001 /N 3005 7403 /O 0370 7403 /P 4560 7603 /Q 2370 7503 /R 4572 7602 /S 6360 5001 /T 1150 7001 /U 6005 6001 /V 4011 7401 /W 6205 5001 /X 1007 6401 /Y 1330 7002 /Z 0074 7001 / 0154 4002 / 0044 7000 / 3050 5404 / 6070 6404 /B.A. 2074 0000 /SP 7000 /EXECUTE 3 "INVISIBLE" VECTOR STROKES. 5006 /! 2046 5006 /" 3201 5245 /# 5572 7642 /$ 6363 6740 /% 1675 6760 /& 3637 4006 /' 3000 6001 /( 0124 6001 /) 1202 5204 /* 7700 5004 /+ 6014 4006 /, 0030 4004 /- 0014 4006 /. 0060 4002 // 4400 7601 /0 3107 6401 /1 0456 7602 /2 1714 5503 /3 4770 6402 /4 0364 7600 /5 3434 7603 /6 0175 6002 /7 0070 5703 /8 4770 7402 /9 0364 5006 /: 1460 5006 /; 1430 6002 /< 2120 5005 /= 5500 6002 /> 4240 7506 /? 6346 /THIS IS THE LAST OF THE CHARACTER DISPATCH TABLE..... END=. > XLIST 0 $$$