File OS8B01.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/7	OS/8 SUPPORT TASK FOR RTS-8 V2B
	VERS=	1
	XLIST	1		/COPYRIGHT ALSO GIVEN IN PARAM.PA
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	XLIST	0	/LIST TASK
	XLIST	1
	IFDEF	OS8	<XLIST 0>
CUR=	0	/MUST LOAD INTO FIELD 0 - CUR REFERENCED FROM OS8F ALSO
	IFDEF	OS8	<

TASK=	OS8
INIWT=	0

/EDIT HISTORY:
/CHANGES SINCE SHAWN'S EDIT:
/ (SR)	ADDED LINCTAPE AND FLOPPY SUPPORT
/	SET BIT 2 OF LOC 07777 IN OS/8
/ (RL)	FIXED MEMORY FIELD ALLOCATION BUG CAUSING CRASH
/	WHEN RTS8 IS EXITED AFTER RUNNING WITH OS8SUP USING
/	ALL BUT 4K OF A 16K OR LARGER MACHINE.
/ (RL)	ADDED KL8A SUPPORT, FIXED LPT BUG,
/	MADE OSFILL OPTIONAL
/ (SR)	CHANGED KL8A SUPPORT
/	SET BIT 2 IN FAKE FIELD ONLY
/	RUN DDCMP WHEN THROUGH WITH INITIALIZATION
/	NO LONGER USE OS/8
/	SYSTEM HANDLER DURING INITIALIZATION
/
/  OS8B00	RELEASED VERSION V2B
/
/  OS8B01	SCR 4/77 SPR, FIX OS8F INTERLOCK	[01]
/

OS8F0=	HGHFLD		/PUT FAKE FIELD 0 AT TOP OF MEMORY
OS8F1=	1-OSFLDS^10+HGHFLD	/FAKE FIELD 1 GOES AT BOTTOM OF
			/ALLOCATED MEMORY AS IT MAY GO IN FIELD 1!
TEMP=	OSFLDS-1	/OTHER FIELDS WRAP AROUND ALL BUT FIELD 1
OS8F2=	1%TEMP^TEMP-1^10+HGHFLD
OS8F3=	2%TEMP^TEMP-2^10+HGHFLD
OS8F4=	3%TEMP^TEMP-3^10+HGHFLD
OS8F5=	4%TEMP^TEMP-4^10+HGHFLD
OS8F6=	5%TEMP^TEMP-5^10+HGHFLD
OS8F7=	6%TEMP^TEMP-6^10+HGHFLD

OS8DCB=	7760	/ADDRESS OF OS/8 DCB TABLE IN FIELD 1
OS8HND=	7647	/ADDRESS OF OS/8 RESIDENT HANDLER TABLE IN FIELD 1
JSBITS=	7746	/ OS/8 JOB STATUS BITS IN FIELD 0

OSKBML=	7671	/LOCATION IN FIELD 1 WHICH READS THE KEYBOARD MONITOR
OSUSRL=	7723	/LOCATION IN FIELD 1 WHICH READS IN THE USR
OSCDLD=	271	/LOCATION IN USR IN FIELD 1 WHICH READS IN CD
TS8LOC=	200	/LOCATION IN RTS-8

CINT=	6204
SUF=	6274

	IFNDEF	OSFILL		<OSFILL= 0>
	IFNZRO	OSTTDV&6000	<OSTTDV=OSTTDV&770%10>
	IFNZRO	OSTTDV-4&4000	<OSTTDV=KL8ALINE OSTTDV>
	IFNDEF	OSKBDV		<OSKBDV= OSTTDV-1>

	IFZERO	OSTTDV&100	<
KSFX=	OSKBDV^10+6001
KCCX=	OSKBDV^10+6002
KRSX=	OSKBDV^10+6004
KRBX=	OSKBDV^10+6006
TSFX=	OSTTDV^10+6001
TCFX=	OSTTDV^10+6002
TSKX=	OSTTDV^10+6005
TLSX=	OSTTDV^10+6006
	>

	IFNZRO	OSTTDV&100	<
	IFNDEF	KL8ADV	<KL8ADV= 40>
	KLNUM=	OSTTDV&77%2	/KL8A NUMBER (TIMES 2)
	TLSX=	KL8ADV+KLNUM^10+6004
	>

PSKF=	6661		/LINE PRINTER IOT'S
PSIE=	6665
PSLS=	6666
PCIE=	6667



/	FIELD ZERO LOCATIONS FOR OS8SUP

	FIELD	CUR%10

	*166

AC,	0		/OS/8 AC
PC,	0		/OS/8 PC
LINK,	0
UCDF,	0
	HLT		/CDF TO MAPPED OS/8 DF
	JMP I	UCDF
UCIF,	0
	HLT		/CDF TO MAPPED OS/8 IF
	JMP I	UCIF
UIF,	0

/INITIALIZATION CODE - OVERWRITTEN BY RING BUFFERS IFNDEF OS8ORG < OS8ORG= 6200 /NORMAL SPOT FOR OS8SUP IFNZRO KL8A < IFDEF KL8ACT < IFZERO KL8ACT-7400 < OS8ORG= OS8ORG-200> /MAKE ROOM FOR KL8A SERVICE >>> *OS8ORG-1400 /ASSUME BOTH MODULES PRESENT IFNDEF OS8 <*OS8ORG> /CORRECT FOR IFNDEF OS8F <*OS8ORG> /MISSING ONE START, IFZERO OSTTDV&100 < CAL SKPINS TTINT /LINK IN OS/8 TELETYPE IFZERO PDP8E < CAL SKPINS KBINT > > IFNZRO OSTTDV&100 < IOF /INTERRUPTS OFF FOR JMS TAD OSLN /LOAD NUMBER OF KL8A LINE WE ARE CONNECTING TO JMS I KLCNCT /CONNECT TO INTERRUPT FOR THAT LINE KBINT /KEYBOARD INTERRUPTS HERE TTINT /PRINTER INTERRUPTS HERE > OWBASE= START OWLEN= 20 IRBASE= OWBASE+OWLEN IRLEN= 10 IREND= IRBASE+IRLEN CDF CIF OS8F0 /OS/8 INITIALIZATION CODE LOADS JMS I OSINIT /INTO OS/8 FAKE FIELD 0 JMP I .+1 STKBMN /GO LOAD THE OS/8 KEYBOARD MONITOR OSINIT, INITOS IFNZRO OSTTDV&100 < OSLN, OSTTDV&77^4 /LINE NUMBER, SHIFTED FOR USE BY KL8ACT KLCNCT, KL8ACT /KL8A CONNECT ROUTINE > IFNZRO IRBASE&IRLEN <IRBNDY,__ERROR__> IFNZRO OWBASE&OWLEN <OWBNDY,__ERROR__> IFNZRO .-IREND&4000 <ZBLOCK IREND-.>
/ TSS/8 INTERRUPT HANDLER TSINT, DCA AC RAR DCA LINK STA TAD 0 DCA PC /SAVE PC , AC, LINK FROM INTERRUPT CINT /CLEAR USER INTERRUPT FLAG ION /RESTORE INTERRUPTS JMS EXECUT /EXECUTE ONE IOT GOBACK, TAD LINK /GENERAL OS8 STARTUP CLL RAL CLA IAC TAD UCIF+1 DCA .+2 JMS UCDF OP, HLT TAD AC SUF JMP I PC /GO TO OS/8 IN USER MODE PT, 0
/EXECUTE A TRAPPED IOT /CALLED FROM TRAP ROUTINE AND FROM CIF INTERPRETER ("RECURSIVELY") EXECUT, 0 UCIFX, HLT /CDF TO USERS INSTRUCTION FIELD TAD I PC CLL RTR RTR TAD (-1310 /CHECK FOR CDF 0 OR CDF 10 SZA CLA /SINCE THEY ARE THE MOST COMMON THINGS JMP NCDF01 SNL /LINK HAS COMPLEMENT OF FIELD BIT TAD (OS8F1-OS8F0 TAD (CDF OS8F0 /LOAD PROPER CDF BASED ON LINK DCA UCDF+1 XNOP, ISZ PC XERET, JMP I EXECUT /LEAVE EXECUT WITH PC BUMPED NCDF01, AC2000 TAD I PC /GET TRAP INSTRUCTION SNL /IF ITS NOT IOT OR OPR, THE PREVIOUS JMP I (ILLIOT /INST WAS SKP HLT - ERROR TAD (7000 SNL /TEST IOT OR OPR JMP MBHALT /OPR AND (704 TAD (-200 /CHECK FOR CDF OR CIF (OR BOTH) SNA CLA JMP I (DFSTUF /YES - SPECIAL ROUTINES FOR THESE TAD (IOTLST-1 DCA PT TAD I PC DCA OP /SEARCH LEGAL OPCODE LIST CDF CUR SROPLP, ISZ PT TAD I PT ISZ PT SNA JMP I (XNOP /UNDEFINED IOT'S ARE NOP'S TAD OP SZA CLA JMP SROPLP TAD I PT DCA PT JMP I PT /GO PROCESS OPCODE
MBHALT, AND (407 TAD (-404 /OSR ONLY LEGAL OPR SZA CLA JMP I (ILLIOT CLA OSR SKP XRIF, TAD UIF XOR, DCA PT /GENERAL OR WITH AC TAD AC CMA AND PT TAD AC XACSTO, DCA AC JMP XNOP XRDF, JMS DORDF /CALCULATE VIRTUAL DF FROM REAL ONE JMP XOR DORDF, 0 /SLOW ROUTINE TO REVERSE FIELD MAPPING TAD (FLDTBL-1 DCA UCIF /INITIALIZE TBL PTR DRDFLP, ISZ UCIF TAD I UCIF /GET CDF FROM TABLE CIA TAD UCDF+1 /COMPARE WITH MAPPED CDF SZA CLA JMP DRDFLP /LOOP UNTIL MATCH (MUST HAPPEN!) TAD UCIF /GET TABLE ADDRESS TAD (-FLDTBL /NORMALIZE TO 0-7 CLL RTL RAL /SHIFT INTO DF POSITION JMP I DORDF /RETURN WITH DF IN AC PAGE
/KEYBOARD HANDLER XKSF, IOF TAD IRCNT SNA CLA /INPUT BUFFER EMPTY? JMP I (XKSFWT /YES - WAIT ION IFDEF LPT < XLSF, > XSKP, ISZ PC JMP I (XNOP /SKIP AND RETURN XKRB, TAD I IRGET /GET SOMETHING OUT OF THE BUFFER XKCC, DCA AC /INTO THE ACCUMULATOR TAD IRCNT SNA CLA /DON'T EMPTY FROM AN EMPTY BUFFER JMP I (XNOP ISZ IRCNT NOP TAD IRGET IAC AND (-IRLEN-1 DCA IRGET JMP I (XNOP XKRS, TAD I IRGET JMP I (XOR /OR CHAR INTO AC
KBINT, IFZERO OSTTDV&100 < IFZERO PDP8E < 0;0 /LINKAGE INTO SKIP CHAIN KSFX JMP I KBINT CDF CIF 0 > KRBX > AND (377 /STRIP OF ERROR BITS (AND LINE # IF KL8A) DCA I IRPUT TAD I IRPUT AND (177 TAD (-3 /IF ^C,^O,^Q OR ^S TYPED, SNA JMP CTLCHR TAD (3-17 AND (7771 SZA CLA JMP NOCTRC CTLCHR, TAD IRPUT /MAKE IT THE ONLY CHAR IN THE BUFFER DCA IRGET DCA IRCNT NOCTRC, TAD IRPUT /UPDATE PUT POINTER IAC AND (-IRLEN-1 DCA IRPUT TAD IRCNT CIA CLL AND (-IRLEN-1 /BUMP CHAR COUNT MOD IRLEN CMA DCA IRCNT SZL TAD (KSFEF /IF FIRST CHAR IN BUFFER SET EVENT FLAG POSTDS /OTHERWISE JUST DISMISS KSFEF, 1 IRGET, IRBASE IRPUT, IRBASE IRCNT, 0
/ILLEGAL IOT HANDLER - PRINT MESSAGE AND RETURN TO KEYBOARD MONITOR ILLIOT, CLA /CLEAR AC SINCE IT IS RANDOM CDF 0 TAD (ILIOMS DCA LINK ILIOLP, TAD I LINK /PRINT ERROR MESSAGE ON OS/8 TTY SPA /LIST ENDS WITH 4600 JMP PRNTPC JMS I (XTLSUB ISZ LINK JMP ILIOLP PRNTPC, TAD UIF /4600 IN AC HERE CLL RTR RAR JMS I (XTLSUB /PRINT FIELD TAD (-4 DCA LINK TAD PC PCPTLP, CLL RTL RAL DCA UCIF TAD UCIF RAL AND (7 TAD (260 JMS I (XTLSUB /PRINT THE PC IN OCTAL TAD UCIF ISZ LINK JMP PCPTLP /4 DIGITS WORTH I7600, 7600 /CLEAR GARBAGE FROM AC TAD PC CMA AND I7600 /IF THE ILLEGAL IOT WAS IN THE RESIDENT, SNA CLA /DON'T SAVE CORE ON RELOAD TAD (5 /SINCE SYS: IS PROBABLY WRITE PROTECTED. /** FALL INTO NEXT PAGE **
/START KEYBOARD MONITOR AT 07600 STKBMN, TAD I7600 DCA PC DCA AC /AND AC CLEAR TAD (CDF OS8F0 DCA UCDF+1 HNDRET, DCA UIF TAD UCDF+1 DCA UCIF+1 GOBCKX, TAD UCIF+1 CDF 0 DCA I (UCIFX JMP I (GOBACK /START INTERPRETING PAGE
/TELETYPE OUTPUT HANDLER XTSF, CIF 0 /INHIBIT INTERRUPTS FOR A WHILE TAD OWCNT TAD (OWLEN SZA CLA /BUFFER FULL? JMP I (XSKP /NO - SKIP RETURN TAD (TSFEF SKP XKSFWT, TAD (KSFEF DCA EF CLA IAC DCA I EF ION TAD PC ISZ PC AND (177 /CHECK IF NEXT LOCATION IS A "JMP .-1" - TAD (5200 CIA JMS UCIF TAD I PC /IF IT IS WE SHOULD HANG SZA CLA /OTHERWISE DO A NON-SKIP RETURN JMP I (XERET CAL WAITE EF, 0 JMP I (XNOP /DO A SKIP RETURN AFTER WAITING XTCF= XNOP /?? XTLS, TAD AC JMS XTLSUB /CALL SUBROUTINE USED TO PRINT ERRORS IFNZRO OSFILL < TAD UCDF /UCDF = CHAR&177 FROM XTLSUB TAD (-12 SZA CLA JMP I (XNOP /ONLY FILL ON LINE FEEDS JMS XTLSUB JMS XTLSUB JMS XTLSUB JMS XTLSUB /4 FILL CHARS SHOULD SUFFICE > JMP I (XNOP /KEEP ON TRUCKING
XTLSUB, 0 /ROUTINE TO OUTPUT CHAR IN AC AND (177 /STRIP PARITY AND GARBAGE DCA UCDF /SAVE CHAR TAD OWCNT TAD (OWLEN SNA CLA /WAIT FOR BUFFER TO HAVE SPACE JMP .-3 TAD UCDF DCA I OWPUT TAD OWPUT /STORE CHAR IN BUFFER AND BUMP POINTER IAC AND (-OWLEN-1 DCA OWPUT CIF 0 /DELICATE CODE AHEAD STA CLL TAD OWCNT DCA OWCNT /BUMP BUFFER COUNT TAD UCDF IFNZRO OSTTDV&100 <TAD (OSTTDV&77^400 > /ADD LINE # SNL TLSX /PRINT IF FIRST CHAR IN BUFFER CLA JMP I XTLSUB
/TELETYPE OUTPUT INTERRUPT ROUTINE TTINT, IFZERO OSTTDV&100 < ZBLOCK 2 IFZERO PDP8E <TSFX> IFNZRO PDP8E <TSKX> JMP I TTINT CDF CIF 0 IFNZRO PDP8E < TSFX /KEYBOARD OR PRINTER? JMP I (KBINT /KEYBOARD > > IFZERO OSTTDV&100 <TCFX> /CLEAR PRINTER FLAG TAD OWCNT SMA CLA /IGNORE UNSOLICITED INTERRUPTS (LA30) POSTDS TAD OWGET IAC AND (-OWLEN-1 DCA OWGET ISZ OWCNT SKP POSTDS /BUFFER NOW EMPTY - LEAVE TAD I OWGET IFNZRO OSTTDV&100 <TAD (OSTTDV&77^400 > /ADD LINE # TLSX /PRINT NEXT CHAR FROM BUFFER STA TAD OWCNT TAD (OWLEN SNA CLA /IF BUFFER JUST BECAME UNFULL, TAD (TSFEF /SET EVENT FLAG POSTDS /ELSE JUST DISMISS TSFEF, 0 OWGET, OWBASE OWPUT, OWBASE OWCNT, 0
/LINE PRINTER OUTPUT ROUTINE - USES RTS-8 LPT DRIVER IFDEF LPT < XLLS, TAD AC DCA I LPBUF /STORE CHAR IN LPT MESSAGE BUFFER ISZ LPBUF TAD AC AND (177 TAD (-15 /CHECK TO SEE IF THE CHARACTER CLL TAD (3 /IS A FORMS MOVEMENT CHARACTER ISZ LPBUFC /(I.E. LF,VT,OR FF) SZL CLA /OR IF THE MESSAGE BUFFER IS FULL SKP CLA JMP I (XNOP /NEITHER - RETURN TO OS/8 JOB DCA I LPBUF /ZERO IS THE BUFFER END CODE CAL SENDW /MOVE THE BUFFER TO THE LINE PRINTER LPT LPMESG TAD (LPTBUF DCA LPBUF /RE-INITIALIZE THE BUFFER PPOINTER TAD (-LPTCNT DCA LPBUFC /AND COUNTER JMP I (XNOP /AND CONTINUE LPBUF, LPTBUF LPBUFC, -LPTCNT >
IFNDEF LPT < XLLS, ISZ LPFST SKP JMP .+3 PSKF JMP .-1 /OH, HOW CRUDE! TAD AC PSLS DCA LPFST /CLEAR FIRST-TIME FLAG JMP I (XNOP LPFST, -1 XLSF, PSKF /IF THE FLAG IS NOT UP, JMP I (XNOP /BE A NOP JMP I (XSKP /OTHERWISE BE A SKIP > PAGE
/CODE TO HANDLE CDF'S AND CIF'S DFSTUF, TAD I PC DCA WD CLA IAC AND WD /CHECK CDF BIT SNA CLA JMP NOCDF TAD WD AND (70 JMS I (GETFLD /MAP TO CDF TO REAL FIELD DCA UCDF+1 /SAVE IN CDF SUBR NOCDF, AC0002 AND WD SNA CLA JMP I (XNOP /WHEW! TAD WD /UNLUCKY US - A CIF AND (70 DCA IBR /SAVE IF BACKUP ISZ PC TAD IBR CIA TAD UIF /IF ITS A CIF TO CURRENT FIELD, SNA CLA /EXIT IMMEDIATELY BYPASSING EXECUT RETURN JMP I (GOBACK /AND POSSIBLE SUBSEQUENT USELESS SIMULATION CIFLP, JMS UCIF TAD I PC DCA WD /GET WORD TO INTERPRET TAD WD SPA CLA JMP NONSTD JMS GEFADR /GET EFFECTIVE ADDRESS TAD WD AND T7000 /ISOLATE OPCODE TAD (AND I WT /FORM EQUIVALENT INSTRUCTION DCA WD JMP XINLIN /AND EXECUTE IT IN LINE
/SUBROUTINE TO COMPUTE EFFECTIVE ADDRESSES GEFADR, 0 TAD WD AND (177 DCA WT TAD WD AND (200 CIA AND PC TAD WT DCA WT /ADD PAGE BITS TO DISPLACEMENT JMS UCIF TAD WD AND (400 SNA CLA /IF NO INDIRECT ADDRESS, JMP I GEFADR /OPERAND FIELD = IF TAD WT AND (7770 TAD (7770 SNA CLA /TEST FOR AUTO-XRS ISZ I WT TAD I WT DCA WT JMS UCDF /IF INDIRECT ADDRESSING, JMP I GEFADR /OPERAND FIELD = DF NONSTD, TAD WD CLL RTL SNL /CHECK FOR JMP OR JMS JMP JMPJMS /YES - NOT LONG NOW SPA JMP XOPR /SEPARATE THE IOTS FROM THE OPRS CLA JMS I (EXECUT /WE CAN CALL EXECUT "RECURSIVELY" HERE SINCE JMP CIFLP /WE DON'T PLAN ON RETURNING FROM THIS LEVEL XOPR, AND (6014 /7403 ROTATED LEFT 2 TAD (-6010 /7402 ROTATED LEFT 2 SNA CLA JMP I (ILLIOT XINLIN, TAD LINK CLL RAL TAD AC WD, 0 SKP /WATCH FOR SKIPS AND ISZ'S ISZ PC ISZ PC T7000, NOP /JUST IN CASE DCA AC RAR DCA LINK JMP CIFLP
/INTERPRET JMP OR JMS JMPJMS, CLA JMS GEFADR /GET EFFECTIVE ADDRESS TAD IBR JMS I (GETFLD /GET TARGET FIELD DCA UCIF+1 TAD IBR DCA UIF JMS UCIF TAD WD RTL /CHECK FOR JMS SPA CLA JMP XJMP /NO CLA IAC TAD PC DCA I WT /SAVE RETURN ADDRESS CLA IAC /AND BUMP JUMP ADDRESS XJMP, TAD WT DCA PC JMP I (GOBCKX WT, 0 IBR, 0 PAGE
/ROUTINE TO HANDLE SPECIAL OS/8 HANDLER IOT /FORMAT OF SPECIAL IOT USAGE IS AS FOLLOWS: / TAD (INTERNAL DEVICE CODE / 6000 /DATA FIELD IS FIELD OF HANDLER ARGUMENTS / POINTER TO OS/8 HANDLER ENTRY POINT / RETURN IS TO THE ERROR OR NORMAL RETURN OF THE HANDLER HCALL, JMS UCIF ISZ PC /GO TO NEXT WD TAD I PC DCA PC /PC CONTAINS HANDLER ENTRY PT ADDR TAD I PC DCA PC /PC CONTAINS ARGUMENT LIST ADDR IFDEF OS8F < TAD UCDF+1 TAD (-CDF-OS8F1 SNA CLA /IF WE ARE CALLING THE TAD PC /KEYBOARD MONITOR, TAD (-OSKBML SZA TAD (OSKBML-OSUSRL /USR, SZA TAD (OSUSRL-OSCDLD /OR COMMAND DECODER INTO CORE, SZA CLA /RELEASE THE OS8F INTERLOCK JMP NOPOST /SINCE THE USR DIRECTORY BUFFER IS CLEAR. TAD (INTLOK CAL POST /OS8F INTERLOCK IS A STANDARD EVENT FLAG CDF CUR /IN THE CURRENT FIELD NOPOST, > TAD AC AND (7760 /CHECK UNIT NUMBER LT 16. SZA CLA JMP I (ILLIOT /IF NOT, ILLEGAL IOT TAD (HNDTAB TAD AC DCA AC JMS UCDF /ARG LIST IN DATA FIELD TAD I PC AND (7707 DCA ARGS+1 /GET FIRST WORD EXCEPT FOR FIELD TAD I PC AND (70 JMS I (GETFLD /[01]RELOCATE BUFFER FIELD AND (70 TAD ARGS+1 DCA ARGS+1
ISZ PC TAD I PC DCA ARGS+2 ISZ PC TAD I PC DCA ARGS+3 IFDEF OS8F < CLA IAC TAD ARGS+3 AND (7770 /IF THE I/O IS TO A DIRECTORY BLOCK SNA /WE MUST SET THE OS8F INTERLOCK TAD INTLOK /(IF IT WAS CLEAR) TO PREVENT SNA CLA /SIMULTANEOUS UPDATE OF ISZ INTLOK /THE OS/8 DIRECTORY > ISZ PC NOP /PROTECT AGAINST WIERD OR MALICIOUS BACKGROUNDERS CDF CUR TAD I AC /GET HANDLER TASK NUMBER SNA JMP I (ILLIOT /ILLEGAL HANDLER IOT CLL RTR RAR AND (177 /IN BITS 3-8 OF TABLE ENTRY DCA HTASK TAD I AC /GET UNIT NUMBER AND (7 /IN BITS 9-11 DCA ARGS CAL SENDW /SEND THE I/O REQUEST TO THE APPROPRIATE TASK HTASK, 0 IOMESS /AND WAIT FOR COMPLETION TAD IOSTS /USE RETURN STATUS TO DETERMINE SNA /WHETHER WE FAKE A NORMAL OR ERROR RETURN ISZ PC SZA CLA AC4000 /TRADITIONAL ERROR VALUE DCA AC JMS I (DORDF /MAP PHYSICAL FIELD IN UCDF+1 TO VIRTUAL FIELD JMP I (HNDRET /RETURN FROM OS/8 HANDLER IOMESS, ZBLOCK 3 /HANDLER MESSAGE ARGS, ZBLOCK 4 IOSTS, 0 INTLOK, 0 /OS8-OS8F INTERLOCK - 0 MEANS DIR FREE
/ / EDIT [01] REARRANGE TO FIT; CODE THRU '0' / / TABLE OF LEGAL IOT'S / IOTLST, -RDF; XRDF -RIF; XRIF -KSF; XKSF -KCC; XKCC -KRS; XKRS -KRB; XKRB -TSF; XTSF -TCF; XTCF -TLS; XTLS -PSLS; XLLS -PSKF; XSKP -6000; HCALL 0 PAGE
/OS8 FILE SUPPORT INTERLOCK TEST ROUTINE / EDIT [01] INIT XR AND LENGTH IN THIS ROUTINE IFDEF OS8F < /ONLY ASSEMBLED IF NEEDED CKINTL, 0 WTINTL, CAL /WAIT FOR OS/8 TO REACH A STATE IN WHICH WAITE /THERE IS NO POSSIBILITY OF AN ACTIVE PINTLK, INTLOK /DIRECTORY BUFFER IN THE USR. TAD (HNDTAB /[01]INIT XR AND LENGTH INTERNALLY, DCA XR /[01]AS WE MAY LOOP BETWEEN CALLS TO CKINTL TAD (-17 /[01] DCA LENGTH /[01] HNDLP, TAD I (FN AND (1777 /SEE IF OUR DEVICE IS IN THE OS/8 SYSTEM CIA TAD I XR /BY SEARCHING THE OS8 SUPPORT TASK'S SNA CLA /TABLES FOR IT JMP FNDOSD /FOUND IT ISZ LENGTH JMP HNDLP /KEEP LOOKING JMP I CKINTL /NOT THERE - NO INTERLOCK FNDOSD, TAD XR TAD (OS8DCB-1-HNDTAB DCA LENGTH /GET POINTER INTO THE DCB ENTRY FOR THE CDF OS8F1 /DEVICE INVOLVED TAD I LENGTH AND (7 /CHECK FOR OPEN OUTPUT FILE ON THE DEVICE CDF CUR SNA CLA JMP I CKINTL /NONE - NO INTERLOCK ISZ I PINTLK /OOPS - WE CAN'T TOUCH DIRECTORY NOW JMP WTINTL /WAIT UNTIL THE NEXT QUIET MOMENT > /TABLE OF CORRESPONDENCES BETWEEN OS/8 CODE NUMBER AND TASK NUMBER HNDTAB, ZBLOCK 20 /FIRST WORD IS UNUSED - MUST BE 0
/ / EDIT [01] REARRANGE CODE THRU 'CDF OS8F7' FOR PAGE FIT / GETFLD, 0 /ROUTINE TO MAP FIELDS CLL RTR RAR TAD (TAD FLDTBL DCA .+1 /THIS ROUTINE SHOULD LEAVE THE DF UNCHANGED HLT JMP I GETFLD /TABLE OF REAL FIELDS FLDTBL, CDF OS8F0 CDF OS8F1 CDF OS8F2 CDF OS8F3 CDF OS8F4 CDF OS8F5 CDF OS8F6 CDF OS8F7 LPTCNT= 44 /AS MUCH AS I CAN SPARE RIGHT NOW IFNDEF OS8F <LPTCNT=LPTCNT+34> LPMESG, ZBLOCK 3 6000 /UNPACKED ASCII, NO CRLF 0 /DUMMY INPUT BUFFER WORD LPTBUF, ZBLOCK LPTCNT+1 /ASSURE A ZERO AT THE END ILIOMS, 15;12 ZBLOCK OSFILL /WATCH GARBLING! "H;"A;"L;"T;" ;"A;"T;" ;4600 PAGE
/ OS/8 INITIALIZATION CODE - CREATES FAKE SYSTEM HEAD /AND ESTABLISHES RELATIONSHIP BETWEEN OS/8 DEVICE HANDLER NAMES /AND RTS-8 DRIVERS FIELD OS8F0%10 *4000 /A GOOD SAFE PLACE INITOS, 0 IFNDEF LPT < PSIE /DISABLE LS8E INTS, ENABLE LE8 INTS PCIE /DISABLE LE8 INTS, NOP ON LS8E (I HOPE) > IMOVLP, CDF 0 TAD I P7600 CDF OS8F0 DCA I P7600 CDF 10 TAD I P7600 /MOVE BOTH SYSTEM HEAD PAGES CDF OS8F1 /INTO THEIR FAKE FIELDS DCA I P7600 ISZ P7600 JMP IMOVLP CDF OS8F0 TAD I (7777 /CLEAR OUT THE OS/8 AND (4707 /BATCH IN PROGRESS FLAG TAD (OSFLDS-1^10+1000 /BIT 2 ON TELLS OS/8 THAT RTS-8 IS RUNNING DCA I (7777 /AND SOFTWARE CORE SIZE CDF 0 TAD (TSINT DCA I (TS8LOC /SET UP TSS/8 "TRAP VECTOR" IN RTS-8 EXEC DCA I (JSBITS /MAKE SURE CORE IS SAVED WHEN WE CALL THE USR IMOVHN, CDF OS8F0 TAD I FKHND1 DCA I FKHND2 /MOVE THE RTS-8 FAKE SYSTEM HANDLER INTO PLACE ISZ FKHND1 ISZ FKHND2 ISZ FKHNDC JMP IMOVHN RDUSR, CAL SENDW OSSYSD RDUSRM /READ USR INTO MAPPED FIELD TAD RDUSST /CHECK THAT READ WORKED SZA CLA JMP RDUSR /IF NOT, TRY AGAIN JMP I (INIHNL FKHND1, FAKHND FKHND2, 7607 FKHNDC, FAKHND-FAKEND P7600, 7600 RDUSRM, ZBLOCK 3 0 0600+OS8F1 /READ 6 PAGES INTO MAPPED FIELD 1 0 13 /FROM BLOCK 13 RDUSST, 0
FAKHND, RELOC 7607 /FAKE OS/8 SYSTEM HANDLER FAKSYS, ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM /17(8) ENTRY POINTS ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM ISZ DVNUM F17, 17 CLA /JUST IN CASE TAD DVNUM /GET ENTRY POINT NUMBER CMA TAD FAKTAD /TRANSFORM INTO "TAD" ON ENTRY POINT DCA .+1 HLT /GET CALLING ADDRESS DCA FAKPTR AC2000 TAD .-3 /NOW FORM A "DCA ENTRY POINT" DCA .+2 TAD FAKISZ HLT /RESTORE ENTRY POINT TAD DVNUM CIA FAKTAD, TAD F17 /GET RTS-8 INTERNAL REFERENCE NUMBER DCA FAKT DCA DVNUM /CLEAR DVNUM FOR NEXT CALL TAD FAKT 6000 /MAGIC IOT FAKPTR /POINTER TO POINTER TO ARGLIST DVNUM, 0 FAKT, 0 FAKPTR, 0 FAKISZ, ISZ DVNUM RELOC FAKEND= . PAGE
/LOOP WHICH RELATES OS/8 AND RTS HANDLERS ASTBPT= 36 INIHNL, CDF OS8F0 ISZ HPTR TAD I HPTR /GET NEXT HANDLER NAME SNA JMP ASDONE /NO MORE ISZ HPTR TAD I HPTR /ADD IN SECOND WORD DCA ASNAM1 /SAVE SUM TAD I HPTR /LOOK AT SECOND WORD AGAIN SNA CLA /IS IT ZERO? JMP .+5 /YES TAD ASNAM1 /NO RAL /FORCE BIT 0 TO A 1 STL RAR DCA ASNAM1 /TO GET INTERNAL FORM OF NAME ISZ HPTR CDF OS8F1 /DF TO FAKE FIELD 1 TAD I (ASTBPT /GET POINTER INTO NAME TABLE DCA OSPTR TAD (-17 DCA OSCNT /17 ITEMS IN TABLE OSHNLP, TAD ASNAM1 CIA TAD I OSPTR SNA CLA /FOUND IT? JMP OSHNFD /YES ISZ OSPTR /NO, POINT TO NEXT ITEM ISZ OSCNT /DONE? JMP OSHNLP /NO, KEEP SEARCHING JMP INIHNL /YES, TRY NEXT NAME OSHNFD, TAD OSCNT TAD (20 DCA ASNAM2 TAD ASNAM2 TAD (OS8HND-1 DCA HNDPTR /GET POINTER INTO RESIDENT HANDLER TABLE TAD ASNAM2 TAD (HNDTAB DCA HTBPTR /AND EQUIVALENT PTR INTO RTS-8 TABLE CDF OS8F1 TAD (FAKSYS-1 TAD ASNAM2 /ASSIGN ONE OF THE 17 ENTRY POINTS IN THE DCA I HNDPTR /FAKE SYSTEM HANDLER TO THIS DEVICE CDF OS8F0 TAD I HPTR /GET THE RTS-8 TASK AND UNIT NUMBER CDF 0 DCA I HTBPTR /MAKE THE CORRESPONDING ENTRY IN THE /OS8 SUPPORT TASK TABLE JMP INIHNL /GET THE NEXT HANDLER ASDONE, TAD I (INITOS DCA HPTR IFDEF DDCMP < TAD (DDCMP CAL RUN /RUN DDCMP AFTER INITIALIZATION > CDF CIF 0 JMP I HPTR /RETURN TO OS8SUP HTBPTR, 0 HNDPTR, 0 ASNAM1, 0 ASNAM2, 0 OSCNT, 0 OSPTR, 0 HPTR, HTBL-1 PAGE
/DEVICE CORRESPONDENCE TABLE HTBL, DEVICE SYS OSSYSD^10 DEVICE DSK OSSYSD^10 IFDEF DTA < DEVICE DTA0 DTA^10+0 DEVICE DTA1 DTA^10+1 DEVICE DTA2 DTA^10+2 DEVICE DTA3 DTA^10+3 DEVICE DTA4 DTA^10+4 DEVICE DTA5 DTA^10+5 DEVICE DTA6 DTA^10+6 DEVICE DTA7 DTA^10+7 >
IFDEF RK8 < DEVICE RKA0 RK8^10+0 DEVICE RKB0 RK8^10+4 DEVICE RKA1 RK8^10+1 DEVICE RKB1 RK8^10+5 DEVICE RKA2 RK8^10+2 DEVICE RKB2 RK8^10+6 DEVICE RKA3 RK8^10+3 DEVICE RKB3 RK8^10+7 > IFDEF LTA < DEVICE LTA0 LTA^10+0 DEVICE LTA1 LTA^10+1 DEVICE LTA2 LTA^10+2 DEVICE LTA3 LTA^10+3 DEVICE LTA4 LTA^10+4 DEVICE LTA5 LTA^10+5 DEVICE LTA6 LTA^10+6 DEVICE LTA7 LTA^10+7 > IFDEF RX8A < DEVICE RXA0 RX8A^10+0 DEVICE RXA1 RX8A^10+1 > IFDEF RX8B < DEVICE RXB0 RX8B^10+0 DEVICE RXB1 RX8B^10+1 > IFDEF RX8C < DEVICE RXC0 RX8C^10+0 DEVICE RXC1 RX8C^10+1 > IFDEF RX8D < DEVICE RXD0 RX8D^10+0 DEVICE RXD1 RX8D^10+1 > IFDEF OS8COM < DEVICE RTS8 OS8COM^10 > 0 PAGE > XLIST 0
/OS/8 FILE SUPPORT TASK IFNDEF OS8F <XLIST 1> IFDEF OS8F < /PROVIDES RTS-8 TASKS WITH THE FACILITY TO LOOKUP, ENTER /AND DELETE FILES IN OS/8 DIRECTORIES. TASK2= OS8F CUR2= CUR INIWT2= 0 /THE FORMAT OF A MESSAGE TO THIS TASK IS: /WORD 1 MESSAGE EVENT FLAG /WORDS 2&3 RESERVED FOR RTS-8 /WORD 4 FUNCTION WORD: / BITS 0-1 00=LOOKUP,10=DELETE,01=11=ENTER / BITS 3-8 TASK NUMBER OF DEVICE HANDLER / BITS 9-11 UNIT NUMBER /WORD 5 POINTER TO FILE NAME /WORD 6 GETS A 0 IF SUCCESSFUL, ERROR CODE IF NOT /WORD 7 GETS BLOCK NUMBER AFTER SUCCESSFUL LOOKUP OR ENTER /WORD 8 GETS FILE LENGTH AFTER LOOKUP / SPECIFIES DESIRED FILE LENGTH ON ENTER /PAGE 0 LOCATIONS: FIELD CUR%10 *16 XR, 0 *160 BLOCK, 0 /CURRENT BLOCK NUMBER LENGTH, 0 /CURRENT LENGTH PTNAME, 0 /POINTER TO FILE NAME NFILES, 0 /NUMBER OF FILES IN THIS SEGMENT ETMP, 0 /TEMPORARIES FOR "ENTER" EPTR, 0
*6200 IFNZRO KL8A < IFDEF KL8ACT < IFZERO KL8ACT-7400 < *6000 >>> START2, CAL RECEIVE /WAIT FOR A MESSAGE AND PULL IT IN MADDR, 0 DCA MSGCDF JMS MCDF /SET DF TO MESSAGE FIELD TAD I MADDR DCA FN /SAVE FUNCTION ISZ MADDR TAD I MADDR DCA PTNAME /SAVE PTR TO FILE NAME ISZ MADDR CDF CUR TAD FN AND (7 DCA UNIT /UNIT NUMBER IN BITS 9-11 OF FUNCTION WORD TAD FN CLL RTR RAR AND (77 /HANDLER'S TASK NUMBER IN BITS 3-8 DCA IOTASK TAD FN CLL RAL SPA CLA /FUNCTIONS ARE: JMP ENTER /0000=LOOKUP, 2000=DELETE, 4000&6000=ENTER SNL CLA JMP LOOKUP JMS I (PURGE /DELETE - PURGE FILE NAME FROM OS/8 DIRECTORY NOFILE, IAC /ERROR RETURN - SET STATUS CODE FINI, JMS MCDF DCA I MADDR /STORE STATUS CODE ISZ MADDR TAD BLOCK DCA I MADDR ISZ MADDR TAD LENGTH /STORE BLOCK NUMBER AND LENGTH IN MESSAGE DCA I MADDR IFDEF OS8 < TAD (OS8 CAL /RESUME OS/8 EXECUTION RUN > TAD MSGCDF DCA MEFCDF TAD MADDR TAD (-7 CAL POST FN, MEFCDF, 0 /POST MESSAGE EVENT FLAG JMP START2 /GET NEXT MESSAGE MCDF, 0 MSGCDF, HLT JMP I MCDF
LOOKUP, JMS I (MDSRCH /FIND FILE NAME IN DIRECTORY JMP NOFILE /NOT FOUND JMP FINI /FOUND. ENTER, JMS I (PURGE /DELETE PREVIOUS COPY OF FILE NOP /FILE NOT FOUND - WHO CARES? AC0002 TAD MADDR DCA LENGTH JMS MCDF TAD I LENGTH /GET DESIRED LENGTH CDF CUR JMP I (ENTERX MRDCAT, 0 /DIRECTORY READ ROUTINE DCA DBLOCK /ENTER WITH BLOCK NUMBER IN AC JMS MREADC /READ DIR BLK TAD I (DSTBLK DCA BLOCK /INITIALIZE BLOCK NUMBER FROM DIRECTORY HEADER TAD I PDCNT DCA NFILES /INITIALIZE FILE COUNT TAD (DBODY-1 DCA XR /INITIALIZE DIRECTORY FILE PTR JMP I MRDCAT MREADC, 0 /LOW-LEVEL DIRECTORY READ/WRITE ROUTINE TAD (200+CUR DCA IOCTLW /STORE READ OR WRITE CONTROL WORD CAL SENDW IOTASK, 0 IOMSG TAD IOSTAT SZA JMP FINI /I/O ERROR - RETURN I/O STATUS AS ERROR TAD I PDCNT CMA CLL TAD I (DLINK AND (7700 SNL /VALIDATE THE DIRECTORY BUFFER SZA CLA SKP /BAD JMP I MREADC AC4000 JMP FINI /ERROR 4000 - BAD OS/8 DIRECTORY BLOCK
IOMSG, ZBLOCK 3 UNIT, 0 /UNIT NUMBER IOCTLW, 0 /I/O CONTROL WORD PDCNT, DBUF /BUFFER PTR DBLOCK, 0 /BLOCK NUMBER IOSTAT, 0 /COMPLETION STATUS MEOVLS, ZBLOCK 10 /TEMPORARY STORAGE FOR DIRECTORY EXPANDER PAGE
ENTERX, DCA LENGTH /STORE DESIRED LENGTH RENTER, DCA EPTR /SET FOUND POINTER TO 0 CLA IAC ENSEGL, JMS I (MRDCAT /GET NEXT DIRECTORY SEGMENT ENSRCL, TAD I XR /GET NEXT ENTRY SNA CLA JMP EMPTY /IT'S EMPTY AC7775 /IT'S A FILE - SKIP IT JMS I (BUMPXR TAD I XR ELEND, CIA TAD BLOCK /UPDATE BLOCK NUMBER DCA BLOCK ISZ NFILES JMP ENSRCL TAD EPTR SZA CLA /DID WE FIND A SUITABLE EMPTY IN THIS SEGMENT? JMP EINRTS /YES TAD I (DLINK /NO - GO TO NEXT SEGMENT SZA JMP ENSEGL ENTERR, AC0002 /NO MORE SEGMENTS - ENTER ERROR JMP I (FINI EMPTY, TAD I XR DCA ETMP /SAVE LENGTH OF EMPTY TAD EPTR SZA CLA /DO WE ALREADY HAVE A GOOD EMPTY? JMP ENOGD /YES - DISREGARD THIS'N CLL STA TAD ETMP TAD LENGTH SNL CLA /IS IT LARGE ENOUGH? JMP ENOGD /NO TAD XR DCA EPTR TAD BLOCK DCA EBLOCK ENOGD, TAD ETMP JMP ELEND /UPDATE BLOCK NUMBER
EINRTS, TAD XR DCA ETMP /SAVE POINTER TO END OF SEGMENT TAD I EPTR /GET LENGTH OF GOOD EMPTY TAD LENGTH SNA CLA /CHECK FOR EXACT FIT AC0002 /YES - EMPTY WILL DISAPPEAR TAD (-4 JMS I (BUMPXR JMS CKOVFL /CHECK SEGMENT OVERFLOW JMS MOVEUP TAD I EPTR TAD LENGTH SNA ISZ I (DBUF /REDUCE FILE COUNT BY 1 FOR KILLED EMPTY NOP SZA DCA I XR /OTHERWISE STORE UPDATED LENGTH STA TAD ETMP DCA XR /RESTORE END-OF-SEGMENT POINTER TO XR TAD (-4 DCA ETMP NMOVLP, JMS I (MCDF TAD I PTNAME ISZ PTNAME CDF CUR DCA I XR /MOVE FILE NAME INTO DIRECTORY SEGMENT ISZ ETMP JMP NMOVLP CDF 0 TAD I (DATE CDF CUR DCA I XR /STORE SYSTEM DATE IN ADDITIONAL INFO WORD #1 CLA IAC JMS I (BUMPXR TAD LENGTH CIA DCA I XR /STORE LENGTH OF NEW FILE STA TAD I (DBUF /INCREMENT FILE COUNT DCA I (DBUF AC4000 /WRITE THIS SEGMENT BACK OUT JMS I (MREADC TAD EBLOCK DCA BLOCK /RESTORE BLOCK FOR STORING INTO MESSAGE JMP I (FINI
EBLOCK, 0 MOVEUP, 0 /ROUTINE USED BY ENTER AND "NOROOM" TAD I ETMP DCA I XR /TRANSFER A WORD TAD ETMP CMA TAD EPTR SNA CLA JMP I MOVEUP /ENOUGH WORDS - DONE STA TAD ETMP DCA ETMP AC7776 TAD XR DCA XR JMP MOVEUP+1 CKOVFL, 0 /CHECK DIRECTORY SEGMENT OVERFLOW TAD I (DEXTRA CIA TAD XR /MUST BE ROOM FOR 1 DUMMY ENTRY TAD (-DBUF-372 SMA CLA JMP I (NOROOM /THERE ISN'T - MUST ADJUST SEGMENTS JMP I CKOVFL PAGE
MDSRCH, 0 /DIRECTORY SEARCH ROUTINE CLA IAC SRSEGL, JMS I (MRDCAT MDSRCL, TAD PTNAME DCA PTN /GET POINTER TO FILE NAME WORD 1 TAD (-4 DCA CT TAD I XR SNA /CHECK TYPE OF ENTRY JMP SKPMTF /EMPTY SKP /SKIP INTO SEARCH LOOP SRCWDL, TAD I XR CIA JMS I (MCDF TAD I PTN ISZ PTN CDF CUR SZA CLA /COMPARE FILE NAME AGAINST DIRECTORY ENTRY JMP NXTFIL ISZ CT JMP SRCWDL JMS BUMPXR /SUCCESSFUL MATCH TAD I XR /GET LENGTH WORD SNA JMP SKPMTF+1 /LENGTH 0 FILES ARE TENTATIVES DCA LENGTH ISZ MDSRCH JMP I MDSRCH /TAKE SKIP RETURN IF SUCCESS NXTFIL, TAD CT IAC JMS BUMPXR /SKIP TO END OF FILE NAME IN SEGMENT SKPMTF, TAD I XR CIA TAD BLOCK /UPDATE BLOCK NUMBER DCA BLOCK ISZ NFILES JMP MDSRCL TAD I (DLINK /SEGMENT EXHAUSTED - ON TO NEXT SEGMENT SNA JMP I MDSRCH /NO NEXT SEGMENT - TAKE ERROR EXIT JMP SRSEGL BUMPXR, 0 TAD I (DEXTRA /GET NUMBER OF ADDITIONAL INFO WORDS CIA TAD XR /BUMP POINTER BY AC+A.I.WORDS DCA XR JMP I BUMPXR CT, 0 PTN, 0
PURGE, 0 /ROUTINE TO PURGE A FILE FROM THE DIRECTORY IFDEF OS8 < /MUST INTERLOCK WITH BACKGROUND / / EDIT [01] MOVE INIT CODE FOR XR AND LENGTH TO ROUTINE CKINTL / JMS I (CKINTL /CHECK IT TAD (OS8 /MADE IT! - SUSPEND OS/8 CAL /SO WE WON'T HAVE ANY TROUBLE SUSPND > /END INTERLOCK CONDITIONAL JMS MDSRCH /SEARCH DIRECTORY FOR FILE NAME JMP I PURGE /NO SUCH FILE - ERROR EXIT ISZ PURGE AC7776 TAD XR DCA XR /POINT XR AT LENGTH WORD - 1 TAD XR DCA SQP ISZ SQP DCA I SQP /ZERO LENGTH WORD -1 AC7775 TAD I (DEXTRA JMS SQUISH /SQUISH OUT FILE NAME, LEAVING EMPTY JMS CONSUL /ELIMINATE PAIRS OF EMPTIES AC4000 JMS I (MREADC /WRITE OUT THIS SEGMENT JMP I PURGE /AND RETURN CONSUL, 0 /ROUTINE TO CONSOLIDATE A DIRECTORY TAD (DBODY-1 DCA XR TAD I (DBUF DCA CT CONLP, TAD I XR SNA CLA JMP PEMPTY /GOT AN EMPTY - CHECK FOR 2 PSKIPF, TAD (-4 JMS BUMPXR /SKIP PAST FILE NAMES ISZ CT JMP CONLP JMP I CONSUL /DONE - RETURN PEMPTY, ISZ XR TAD XR DCA SQUISH /SAVE POINTER TO FIRST LENGTH WORD ISZ CT SKP JMP I CONSUL /LAST ENTRY WAS EMPTY - WE'RE DONE TAD I XR SZA CLA JMP PSKIPF /NON-EMPTY - NO SQUISH TAD I XR TAD I SQUISH DCA I SQUISH AC7776 JMS SQUISH /SQUISH OUT REDUNDANT EMPTY ISZ I (DBUF JMP CONSUL+1 /START ALL OVER AGAIN
SQUISH, 0 /LOW LEVEL COMPRESS ROUTINE TAD XR DCA SQP SQLOOP, TAD I XR ISZ SQP DCA I SQP TAD XR TAD (-DBUF-377 SZA CLA JMP SQLOOP JMP I SQUISH SQP, 0 PAGE
NOROOM, TAD I (DLINK SNA CLA /LAST SEGMENT? JMP MELAST /YES - SPECIAL PROCEDURE ISZ I (DBUF /DECREASE ENTRY COUNT BY 1 AC4000 JMS I (MREADC /WRITE OUT THIS SEGMENT JMS MSKIPF /FIND END OF SHORT SEGMENT DCA MEFCNT /INITIALIZE LENGTH COUNTER TAD (MEOVLS-1 DCA EPTR MVLP1, TAD I XR ISZ EPTR DCA I EPTR ISZ MEFCNT TAD XR CIA TAD ETMP /MOVE LAST FILE NAME TO SAFE PLACE SZA CLA JMP MVLP1 TAD I ETMP DCA MEOCNT /SAVE LENGTH OF LAST ENTRY TAD I (DLINK JMS I (MRDCAT JMS I (CONSUL /PRE-SQUISH NEW SEGMENT TAD I (DSTBLK TAD MEOCNT /BUMP DOWN FILE ORIGIN DCA I (DSTBLK JMS MSKIPF /FIND END OF SEGMENT TAD XR DCA ETMP STA TAD MEFCNT TAD XR DCA XR /BUMP XR BACK BY NEW FILE ENTRY LENGTH TAD (DBODY+1 DCA EPTR JMS I (MOVEUP TAD (MEOVLS-1 DCA XR STA TAD I (DBUF DCA I (DBUF /INCREASE ENTRY COUNT TAD MEFCNT CIA JMP MECOMN
MELAST, TAD (7 /MOVE 7 FILES INTO BRAND NEW SEGMENT TAD I (DBUF DCA I (DBUF /DECREASE ENTRY COUNT BY 7 JMS MSKIPF /FIND NEW END OF SEGMENT TAD I (DBLOCK AND (7 IAC DCA I (DLINK /LINK THIS SEGMENT TO NEW ONE TAD I (DLINK TAD (-7 SMA CLA /HAVE WE RUN OUT OF SEGMENTS? JMP I (ENTERR /YES AC4000 JMS I (MREADC /WRITE OUT TRUNCATED BLOCK ISZ I (DBLOCK /SET UP TO WRITE NEW BLOCK TAD (-7 DCA I (DBUF TAD MEOCNT CIA TAD I (DSTBLK /NEW START BLOCK = OLD START BLOCK DCA I (DSTBLK /PLUS LENGTH OF OLD SEGMENT DCA I (DLINK /MARK AS NEW LAST SEGMENT TAD XR TAD (-DBUF-377 /MOVE TOP OF DIRECTORY DOWN MECOMN, DCA MEFCNT TAD (DBODY-1 DCA EPTR MVLP2, TAD I XR ISZ EPTR DCA I EPTR /COPY NEW FILE INTO NEW SEGMENT ISZ MEFCNT JMP MVLP2 JMS MSKIPF /SKIP TO END OF SEGMENT TAD XR DCA ETMP /SAVE FOR POSSIBLE ITERATION JMS I (CKOVFL /CHECK FOR NEW SEGMENT OVERFLOW AC4000 JMS I (MREADC /WRITE OUT SEGMENT JMP I (RENTER /START ENTER OVER AGAIN
MSKIPF, 0 /ROUTINE TO SKIP TO END OF SEGMENT TAD I (DBUF DCA MNOFIL TAD (DBODY-1 DCA XR DCA MEOCNT /KEEP RUNNING LENGTH ON THE WAY MSKPLP, TAD I XR SNA CLA JMP MEOMTY AC7775 JMS I (BUMPXR /BUMP PAST FILE NAME MEOMTY, TAD I XR TAD MEOCNT DCA MEOCNT /UPDATE LENGTH ISZ MNOFIL JMP MSKPLP JMP I MSKIPF MNOFIL, 0 MEFCNT, 0 MEOCNT, 0 PAGE
DBUF, 0 /DIRECTORY BUFFER - FIRST WD IF FILE CT DSTBLK, 0 /STARTING BLOCK FOR FILES IN THIS SEGMENT DLINK, 0 /LINK TO NEXT SEGMENT DOPTR, 0 DEXTRA, 0 /NUMBER OF EXTRA WORDS PER FILE ENTRY DBODY, ZBLOCK 373 /BODY OF DIRECTORY > XLIST 0



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search