File KREF.MA (MACREL macro assembler source file)

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

/V2-1 KREF FOR MACREL ET. AL.	RELEASED VERSION
	.SBTTL	MACREL VERSION OF KREF
/	26-AUG-78	FIXED BUF THAT CAUSED LETTER TO BE SKIPPED BETWEEN PASSES
/			ALLOWED PASSES TO DEPEND ON FIRST TWO LETTERS
/			FIXED DATE-78 BUG
/			PREVENT KREF FROM DESTROYING BATCH
	.ASECT ZKREF


/CORE ALLOCATION:

/	PROGRAM		LOW ORDER FIELD 0
/	I/O HANDLERS	ABOVE THAT (OMITTED IF ALREADY RESIDENT)
/	FREESPACE	BEGINS ABOVE THAT
/	I/O BUFFERS	FIELD 1
/	MORE FREESPACE	ABOVE THAT
/	FREESPACE	IN ADDITIONAL FIELDS IF AVAILABLE

	VERNUM="0
	PATCHL="A

.SBTTL FILE AND DATA FORMATS / FORMAT OF KREF FILE: / CONSISTS OF 12-BIT WORDS. STARTS WITH HEADER INFORMATION / AND IS FOLLOWED BY A SEQUENCE OF VARIABLE-SIZE ENTRIES. / AN ENTRY BEGINNING WITH A 0 MEANS LOGICAL END-OF-FILE. / HEADER INFORMATION: /1-3 PROGRAM NAME WHICH PRODUCED THIS FILE (6 CHARS 6-BIT) / WITH NULL PADDING /4 PROGRAM VERSION NUMBER (6-BIT), E.G. '3B' /5 INITIAL PAGE NUMBER FOR CREF LISTING (0 MEANS START WITH PAGE 1) /6 EXTENSION NUMBERS CODE / 0 MEANS NO EXTENSION NUMBERS APPEAR IN FILE / 1 MEANS EXTENSION NUMBERS ARE USED /7 LINE NUMBERS CODE / 0 MEANS MACREL FORMAT (3,3) / 1 MEANS 3-3 / 2 MEANS 3,4 /10 DATE FILE WAS PRODUCED / LINECOUNT AND COLUMN COUNT /11- TITLE TO APPEAR ON TOP LINE (40 CHARS, PADDED WITH NULLS) /XX-YY RESERVED FOR FUTURE USE (FIRST WORD MUST BE 0 FOR NOW) /*** CATEGORIES OF SYMBOLS /REG /PERM /MACROS /LITS (NAME&VALUE) /LOCAL /QUAL? / IMMEDIATELY FOLLOWING THIS HEADER INFORMATION COMES THE ENTRIES. / EACH ENTRY HAS THE FOLLOWING FORMAT /1-3 NAME OF SYMBOL (MACREL 6-BIT, INCLUDES . AND $) /4 HIGH-ORDER WORD OF LINE NUMBER [MUST BE PRESENT] / BITS 0 AND 1 REPRESENT A SPECIAL CODE: / BIT 0: 1 IF THIS IS A DEFINITION ENTRY / BIT 1: 1 IF THIS NAME IS QUALED /5 LOW ORDER WORD OF LINE NUMBER /6 EXTENSION LINE NUMBER [MAY BE OMITTED IF NO-EXTENSION CODE SPECIFIED] /7-10 VALUE AND FLAG FIELD [APPEAR ONLY IF THIS IS A DEFINITION ENTRY] /11-13 QUAL NAME [APPEARS ONLY IF THIS SYMBOL IS QUALED] / FILE SHOULD BE PADDED TO END WITH NULLS.
/ INTERNAL FORMAT OF KREF CHUNKS: / BUCKETS 1-Z POINT TO CHUNKS (USING 15-BIT POINTERS) / EACH CHUNK CONSISTS OF A NAME AND A POINTER TO THE NEXT NAME / CHUNK. THESE ARE ALPHABETICAL. / FORMAT OF NAME CHUNK: /0 POINTER TO NEXT NAME CHUNK. IF 0, THEN THERE ARE NO MORE NAMES / BEGINNING WITH THIS LETTER. GO TO NEXT BUCKET. /1-3 NAME (MACREL 6-BIT CODE) /4 VALUE /5 FLAGS /6 QUAL *** /7 15-BIT POINTER TO REFERENCES CHAIN. THIS ENTRY IS NEVER 0. / FORMAT OF REFERENCE CHUNK: /0 15-BIT POINTER TO NEXT REFERENCE CHUNK. IF 0, THEN THIS IS / THE LAST REFERENCE CHUNK FOR THIS SYMBOL. /1 HIGH ORDER LINE NUMBER WORD / BITS 0 AND 1 HAVE SPECIAL SIGNIFICANCE AND ARE NOT / PART OF THE LINE NUMBER: / SPECIAL CODE: / 0 SYMBOL IS JUST A PLAIN REFERENCE / 1 SYMBOL IS DEFINED HERE, FLAG IT WITH A '#' / 2 RESERVED / 3 RESERVED /2 LOW ORDER LINE NUMBER WORD. THIS WORD IS NEVER 0. **** PROBLEM /3 EXTENSION LINE NUMBER. 0 MEANS THERE IS NO EXTENSION LINE #. /4 HIGH-ORDER PART OF LINE NUMBER WORD FOR 2ND REFERENCE / SAME FORMAT AS WORD 1 ABOVE. /5 LOW ORDER LINE NUMBER WORD OF 2ND REFERENCE. SAME FORMAT / AS 2 ABOVE EXCEPT THAT IF 0, THEN THIS REFERENCE CHUNK / ONLY CONTAINS ONE REFERENCE. /6 EXTENSION LINE NUMBER FOR 2ND REFERENCE. SAME AS WORD 3 ABOVE. /7 UNUSED
.SBTTL PAGE 0 STUFF .ENABLE 7BIT *10 INIT=5600 /*** OS8PTR, 0 /PTS TO LAST CHAR READ FROM /OS/8 INPUT BUFFER XR1, 0 XR2, 0 XR3, 0 XR4, 0 XR5, 0 XR0, 0 *20 READ, 0 JMP I GETRET /COROUTINES GETRET, GETOS JMP I READ INLEN, 0 /NO. OF BLOCKS LEFT TO BE READ /IN CURRENT OS/8 FILE PAGENO, 1 /CURRENT PAGE NUMBER NAME1, 0 NAME2, 0 NAME3, 0 SYMVAL, 0 FLAG, 0 0 QUAL, 0 SYMNUM, 0 TEMP, 0 NUM, 0 OPTR1, 0 OPTR2, 0 FREEPTR,INIT+0 /15-BIT PTR TO FIRST CHUNK OF FREESPACE LPTR, 0 REMAIN, 0 KNT, 0 PAD, 40 ERROR, 0 HLT
ROTL6, 0 CLL RTL RTL RTL JMP I ROTL6 PTR, 0 NAMPTR, 0 HIN1, 0 HIN2, 0 LON1, 0 LON2, 0 EXN1, 0 EXN2, 0 HIN, 0 LINCNT, 0 COLCNT, 0 WIDTH, 120 /80. WIDTH OF OUTPUT DEVICE /FOLLOWING 4 ITEMS CALCULATED BY KREF OUTBUF, 0 /LOCATION OF OUTPUT BUFFER (FIELD 1) INPBUF, 2000 /LOCATION OF INPUT BUFFER (FIELD 1) INHAND, 6600 /LOCATION OF INPUT HANDLER (FIELD 0) OUTHAND,7200 /LOCATION OF OUTPUT HANDLER (FIELD 0)
USR=7700 MQL=7421 ONAME, 0;0;0;0 /NAME OF OUTPUT FILE LINEN2, 0 LINENO, 0 LINEXT, 0 LOLET, 100 /6-BIT OF LOWEST LETTER PAIR CREFFING THIS PASS HILET, 7777 /6-BIT OF HIGHEST LETTER PAIR CREFFING THIS PASS CURLET, 0 /NEGATIVE OF CURRENT LETTER PAIR EXTFLG, 1 /1 MEANS USING EXTENSION NUMBERS NUMTYP, 0 /0: 3,3 /1: 3-3 /2: 3,4 QNAME, 0;0;0 /QUAL NAME OPTR, 7600 /POINTS INTO OUTPUT SPECIFICATION /LIST OUTLN, 0 OUTDEV, 0 OUTEXT, 'LS /DEFAULT OUTPUT EXTENSION OUTL, 0 /NEG OF OUTPUT BUFFERLENGTH (IN DBL WDS) OUTB, 0 /START OF OUTPUT BUFFER INPLEN, 4 /NO. OF BLOCKS IN INPUT BUFFER OUTLEN, 4 /NO. OF BLOCKS IN OUTPUT BUFFER OUTKNT, 0 OUTSIZ, 0 /LENGTH OF OUTPUT FILE BUFKNT, -1 /1'S COMPLEMENT OF # OF WDS /LEFT TO BE READ FROM OS/8 INPUT FILE HEIGHT, 66 /54 LINES PER PAGE
.SBTTL START OF KREF .ASECT KREF *200 FIXMRI INCR=ISZ /INCREMENT, BUT NO SKIP EXPECTED START, STA DCA TEMP$ /NOTE WHETHER WE BEEN CHAINED TO OR NICHT JMS I (ONCE /PERFORM ONCE-ONLY STUFF ISZ TEMP$ /HAD WE BEEN CHAINED TO? JMP A$ /JA CIF 10 /9 JMS I [USR /CALL USER SERVICE ROUTINE TO 5 /PERFORM A COMMAND DECODE 1306 /DEFAULT INPUT EXTENSION IS .KF A$: JMS I (OPEN /OPEN OUTPUT FILE JMS I (IPEN /OPEN INPUT FILE /MAKE KREF REUSABLE /ZERO BUKETS /*** INITIALIZATION JMS I [NEWPAG NEXT: JMP I (DO TEMP$: 0 PAGE
DO, JMS I (HEADER /READ HEADER WORDS NEXT$: JMS I (CTRLC JMS READ /READ SYMBOL SNA JMP I (PRINT /DONE WITH THIS FILE DCA NAME1 JMS READ DCA NAME2 JMS READ DCA NAME3 JMS READ DCA LINEN2 JMS READ DCA LINENO TAD EXTFLG SZA CLA JMS READ /READ LINE NUMBER EXTENSION IF DESIRED DCA LINEXT TAD LINEN2 SMA CLA JMP B$ /NOT A DEFINITION ENTRY JMS READ /DEFINITION ENTRY DCA SYMVAL JMS READ DCA FLAG B$: DCA QNAME TAD LINEN2 RAL SMA CLA JMP LOOK /NO QUAL NAME JMS READ /GET QUAL NAME DCA QNAME JMS READ DCA QNAME+1 JMS READ DCA QNAME+2 LOOK: TAD NAME1 CIA DCA CURLET /GET FIRST (CURRENT) LETTER PAIR OF THIS SYMBOL TAD CURLET STL TAD LOLET SNL SZA CLA JMP NEXT$ /.LT. LOW LETTER, IGNORE ENTRY TAD CURLET STL TAD HILET SZL SNA CLA JMP NEXT$ /.GE. HIGH LETTER, IGNORE ENTRY JMS I [LOOKUP /LOCATE SYMBOL NAME ENTRY IN FREESPACE TAD SYMNUM JMS I [CNVADR TAD [3 DCA XR0 TAD LINEN2 SMA CLA /WAS THIS A DEFINITION ENTRY? JMP D$ /NO TAD SYMVAL /YES DCA I XR0 TAD FLAG DCA I XR0 DCA I XR0 /*** QUAL SKP D$: TAD [3 TAD XR0 DCA XR0 TAD I XR0 /GET LINK TO REFERENCES SNA JMP NEW$ CDF 0 JMS I (LINK TAD [4 DCA XR0 /XR0 PTS TO BEFORE UPPER HALF TAD XR0 IAC DCA XR1 TAD I XR1 SNA CLA JMP E$ /UPPER HALF EMPTY TAD XR0 /UPPER HAL FULL TAD (-3 /PTS TO LINK WORD JMS I [GETMAIN C$: DCA XR0 E$: TAD LINEN2 DCA I XR0 TAD LINENO DCA I XR0 TAD LINEXT /*** DCA I XR0 CDF 0 JMP NEXT$ NEW$: TAD XR0 JMS I (GETMAIN JMP C$ PAGE
NOROOM, CDF 0 TAD HILET CIA TAD LOLET SNA CLA JMP ER3 /OUT OF ROOM ON SINGLE LETTER TAD HILET /RETURN THIS LETTER'S STUFF TO FREESPACE RTR RTR RTR AND [77 TAD (BUKETS DCA LTEM /GET PTR TO BUCKET FOR THIS LETTER STA TAD HILET DCA HILET /MOVE LAST LETTER BACK BY ONE TAD I LTEM /GET PTR INTO CHUNKS SNA JMP NOROOM /EMPTY CHAIN JMS LETRTN DCA I LTEM TAD HILET CIA TAD LOLET AND [7700 SNA CLA JMP I (PRNEXT /IF RAN OUT IN MIDDLE OF LETTER, MUST RESTART JMP I (LOOK ER3, JMS I [ERROR HLT /*** DON'T ABORT, PRINT ERROR MSG & GO ON TO NEXT LETTER
.SBTTL FREEALL LTEM, 0 FREEALL,0 /FREE ALL SLOTS TAD (-100 DCA KNT TAD (BUKETS DCA LTEM 1$: DCA I LTEM INCR LTEM ISZ KNT JMP 1$ JMS I (PREFORM JMP I FREEALL
LETRTN, 0 DCA LPTR TAD LPTR A$: DCA PTR$ TAD PTR$ JMS I [CNVADR TAD [7 DCA TEMP /GET PTR TO REFERENCES TAD I TEMP CDF 0 SZA JMS I (RETRN /RETURN REFERENCES TO FREESPACE TAD PTR$ JMS I [CNVADR DCA TEMP TAD I TEMP /GET PTR TO NEXT NAME FOR THIS LETTER CDF 0 SZA JMP A$ TAD LPTR JMS I (RETRN /RETURN LETTER WORDS TO FREESPACE JMP I LETRTN PTR$: 0 LPTR$:0 PAGE
.SBTTL LINK, GETMAIN, AND RETRN / LINK /INITIAL 15-BIT POINTER IN AC /RETURNS WITH AC POINTING TO WORD BEFORE LINK WORD OF CHUNK /WHICH HAS A 0 LINK WORD (END-OF-CHAIN) /DF SET LINK, 0 JMS I [CNVADR DCA TEMP TAD I TEMP SZA JMP LINK+1 STA TAD TEMP JMP I LINK / GETMAIN /TAKES 12-BIT PTR IN AC /WITH DF ALREADY SET /STORES NEW 15-BIT PTR THERE /GOES TO DF OF NEW CHUNK, PUTS 0 WORD THERE, SETS NEW DF /TAKES RETURN WITH PTR TO PTR IN AC /ZERO CHUNK GETMAIN,0 DCA TEMP TAD FREEPTR SNA JMP I (NOROOM /ERROR RETURN, NO ROOM DCA I TEMP /STORE AWAY NEW PTR TAD FREEPTR JMS I [CNVADR DCA TEMP /GET SECONDARY PTR TAD I TEMP DCA FREEPTR /THIS IS NEW FREESPACE PTR DCA I TEMP /0 IT TAD TEMP DCA XR2 DCA I XR2 DCA I XR2 DCA I XR2 DCA I XR2 DCA I XR2 DCA I XR2 DCA I XR2 TAD TEMP JMP I GETMAIN
/ RETRN /15-BIT PTR IN AC, RETURNS THIS CHAIN TO FREESPACE RETRN, 0 DCA TEMP$ /SAVE CHAIN'S BEGINNING PTR TAD FREEPTR SNA JMP F$ JMS LINK DCA XR0 TAD TEMP$ DCA I XR0 CDF 0 JMP I RETRN F$: TAD TEMP$ DCA FREEPTR JMP I RETRN TEMP$: 0 PAGE
HEADER, 0 JMP I HEADER NEWPAG, 0 DCA LINCNT TAD (214 JMS I [LISTER TAD I [LIST DCA LSTSAV TAD I [CRLF DCA CRSAV /MIGHT BE RECURSIVE CALL CLA IAC /NO CRLF YET JMS I [LIST HDNG TAD PAD DCA PADSAV DCA PAD TAD PAGENO CLL JMS I [DPRINT TAD PADSAV DCA PAD JMS I [CRLF JMS I [CRLF ISZ PAGENO /GO TO NEXT PAGE TAD CRSAV DCA I [CRLF TAD LSTSAV DCA I [LIST JMP I NEWPAG CRSAV, 0 LSTSAV, 0 PADSAV, 0 .ENABLE ASCII HDNG, TEXT /CROSS REFERENCE LISTING/ *.-1 ZBLOCK 30,40 TEXT /KREF V/ *.-1 VERNUM PATCHL ZBLOCK 10,40 TEXT /PAGE / .ENABLE SIXBIT /FIRST WORD ON PAGE SHOULD GO INTO HEADING, DICTIONARY STYLE /TABLE-OF-CONTENTS AT END DAT=HDNG+40 PAGE
.SBTTL PRINT /PRINT INFO FOR ALL LETTERS DONE ON THIS PASS PRINT, TAD LOLET DCA CURLET /START WITH 'LOLET' PRLUP, TAD CURLET JMS I (CB DCA TEMP /POINT TO PROPER BUCKET TAD I TEMP /GET PTR TO NAME CHAIN FOR THIS LETTER LOOP$: SNA JMP I (PRNEXT /DONE WITH THIS LETTER'S CHAIN OF NAMES JMS I [CNVADR TAD (-1 DCA XR0 TAD I XR0 DCA NAMPTR /GET PTR TO NEXT NAME IN NAME CHAIN TAD I XR0 /GET ASCII NAME OUT OF NAME CHUNK DCA NAME1 TAD I XR0 DCA NAME2 TAD I XR0 DCA NAME3 INCR XR0 INCR XR0 INCR XR0 TAD I XR0 DCA PTR /GET PTR TO REFERENCE CHAIN CDF 0 TAD NAME1 /PRINT NAME SPA CLA JMS I (PRDOL TAD NAME1 JMS I [PRNT2 TAD NAME2 JMS I [PRNT2 TAD NAME3 JMS I [PRNT2 PRTAB: TAD (11 JMS I [LISTER /PRINT TAB NEXT$: TAD PTR /GET BACK 15-BIT PTR TO REFERENCE CHAIN SNA JMP END$ JMS I [CNVADR TAD (-1 DCA XR0 TAD I XR0 DCA PTR /SAVE PTR TO NEXT REFERENCE CHUNK TAD I XR0 DCA HIN1 /HIGH ORDER LINE # TAD I XR0 DCA LON1 /LOW ORDER LINE # TAD I XR0 DCA EXN1 /EXTENSION PORTION OF LINE # TAD I XR0 DCA HIN2 /2ND TRIPLE IN CHUNK TAD I XR0 DCA LON2 TAD I XR0 DCA EXN2 CDF 0 JMS I (CTRLC 2$: TAD HIN1 AND (1777 DCA HIN TAD HIN SZA CLA JMP 4$ TAD [40 JMS I [LISTER 3$: TAD [40 DCA PAD CLL TAD HIN SZA CLA STL TAD LON1 / AND (1777 /*** JMS I [DPRINT TAD EXN1 SNA CLA JMP PLEND$ /NO EXTENSION TAD (". JMS I [LISTER DCA PAD TAD EXN1 CLL /SUPPRESS LEADING 0'S JMS I [DPRINT /*** DON'T START ENTRY WITH EXTENSION IF NOT ENOUGH ROOM PLEND$: TAD HIN1 AND (6000 SNA CLA JMP .+3 TAD ("# JMS I [LISTER /FLAG DEFINITION TAD COLCNT TAD [10 AND [7770 CIA TAD WIDTH SPA SNA CLA JMS I [CRLF TAD (11 JMS I [LISTER /PRINT TAB TAD LON2 SNA CLA JMP NEXT$ TAD HIN2 DCA HIN1 TAD LON2 DCA LON1 TAD EXN2 DCA EXN1 DCA LON2 JMP 2$ END$: JMS I [CRLF TAD NAMPTR /GO TO NEXT NAME ENTRY FOR THIS LETTER JMP LOOP$ 4$: DCA PAD TAD HIN CLL JMS I [DPRINT JMP 3$ PAGE
CTRLC, 0 /CHECK FOR ^C FROM TTY TAD [200 KRS TAD (-203 SNA CLA KSF JMP I CTRLC CIF CDF 0 JMP I [7605 PRNEXT, TAD CURLET CLL TAD (100 SZL JMP 1$ DCA CURLET TAD CURLET AND [7700 CIA STL TAD HILET SNL CLA /PAST LAST LETTER? JMP I (PRLUP /NO 1$: CLA TAD HILET /YES IAC SNA CLA /DONE WITH FINAL LETTER? JMP I (FINISH /YES TAD HILET /NO IAC DCA LOLET STA DCA HILET JMS I (FREEALL JMS I (REVISE JMP I (NEXT /HAVE TO MAKE ANOTHER PASS
.SBTTL ONCE ONLY CODE ONCE, 0 JMS I (DATE JMS I (CORE DCA CORE$ TAD CORE$ IAC CLL RAL TAD (LIMTBL DCA TEMP STA DCA I TEMP /LIMIT CORE FOR SYMBOL TABLE STA TAD TEMP DCA TEMP TAD I (7777 RTL /BATCH BIT TO LINK SNL CLA JMP 2$ TAD (5000 DCA I TEMP /DON'T LET KREF DESTROY BATCH 2$: JMS I (PREFORM /FORMAT FREESPACE JMP I ONCE CORE$, 0 /HIGHEST EXISTING CORE FIELD PAGE
.SBTTL OCTAL AND DECIMAL PRINT ROUTINES DPRINT, 0 DCA NUM TAD DT DCA PTR$ JMS NPRINT TAD (DTABLE /RESTORE DT DCA DT /IN CASE SOMEONE NEEDED 4 DIGITS ACCURACY JMP I DPRINT DT: DTABLE /MAY BE DECREMENTED OPRINT: 0 DCA NUM TAD (OTABLE DCA PTR$ JMS NPRINT TAD (DTABLE DCA DT JMP I OPRINT
/LINK ON MEANS PRINT LEADING 0'S , LINK OFF MEANS SUPPRESS THEM NPRINT: 0 /LINK ON MEANS PRINT LEADING 0'S RAR /LINK TO AC0 2$: DCA QUOT$ /ZERO QUOTIENT JMP LOOP$ /JUMP INTO LOOP 1$: DCA NUM /UPDATE REMAINDER INCR QUOT$ /BUMP QUOTIENT BY 1 LOOP$: TAD I PTR$ /SUBTRACT 1000, 100, OR 10 SNA /ARE WE AT END OF TABLE? JMP 1234$ /YES, SAW 0. CLL TAD NUM /SUBTRACT FROM 'NUM' SZL /HAVE WE GONE NEGATIVE? JMP 1$ /NO, KEEP SUBTRACTING CLA /YES, THIS DIGIT DONE INCR PTR$ /POINT TO NEXT DIVISOR IN LIST TAD QUOT$ /LOOK AT NEW DIGIT SNA /IS IT 0? JMP 9$ /YES, IGNORE LEADING 0'S TAD ("0 /NO, CONVERT TO ASCII JMS I [LISTER /OUTPUT DIGIT STL CLA RAR /4000 JMP 2$ /FORCE ZEROES TO PRINT 1234$: TAD NUM /GET REMAINDER (UNIT'S DIGIT) TAD ("0 /CONVERT TO ASCII JMS I [LISTER /ALWAYS PRINT IT JMP I NPRINT /RETURN 9$: TAD PAD /PRINT LEADING 0 AS A SPACE SNA JMP LOOP$ /IGNORE NULLS JMS I [LISTER JMP LOOP$ PTR$: 0
QUOT$: 0 -1000. DTABLE, -100.;-10.;0 OTABLE, -1000;-100;-10;0 PAGE
.SBTTL INPUT ROUTINES GETOS, ISZ BUFKNT /ARE WE THROUGH WITH LAST /WORD IN BUFFER? SKP /NO, PROCESS NEXT THREE CHARACTERS JMS READOS /YES, READ A NEW BUFFER'S WORTH OF /CHARACTERS CDF 10 TAD I OS8PTR /GET NEXT WORD CDF 0 JMS GETRET /SEND IT TO CALLING COROUTINE JMP GETOS /REITERATE
/READ A NEW BUFFER'S WORTH OF WORDS FROM OS/8 DEVICE READOS, 0 STA TAD INPBUF DCA OS8PTR /POINT TO BEGIN OF OS/8 BUFFER TAD INPLEN /SET 'BUFKNT' TO MINUS THE NUMBER OF CLL RTR RTR RAR CIA DCA BUFKNT /WORDS IN OS/8 INPUT BUFFER TAD INPLEN CIA DCA TEMP$ TAD INPLEN CLL RTR RTR RTR TAD [10 /INTO FIELD 1 DCA RDSIZ /GET SET TO READ FULL BUFFER'S WORTH TAD INPLEN DCA INSIZ TAD INPBUF DCA B$ TAD INLEN /GET # OF BLOCKS OF INPUT REMAINING SNA JMP FIN /REACHED END OF FILE CLL TAD TEMP$ /SUBTRACT NUMBER OF BLOCKS WE WISH /TO READ SNL /TO FIND OUT IF WE CAN READ THAT /MANY JMS READSHORT /NO, WE CAN'T READ A FULL /BUFFER'S WORTH FIN: DCA INLEN /YES, WE CAN READ A WHOLE BUFFER /LOAD JMS I INHNDLR /PERFORM A READ RDSIZ: 0 /FUNCTION WORD (FIELD 1 & # /OF PAGES TO READ /NO. OF PAGES ACTUALLY READ FROM /FILE (IN BITS 1-5) B$: 0 /BUFFER STARTING ADDRESS INREC: 0 /INPUT RECORD NUMBER JMP ER14 /INPUT ERROR TAD INREC TAD INSIZ DCA INREC /UPDATE REC NUMBER TO BE READ NEXT JMP I READOS /RETURN TEMP$: 0 /- NO. OF BLOCKS IN INPUT BUFFER INSIZ, 0 ER14, JMS I [ERROR JMP I [7605
READSHORT,0 CLA TAD INLEN DCA INSIZ TAD INSIZ CLL RTR RTR RTR /CONVERT TO # OF PAGES TAD [10 /FIELD 1 DCA RDSIZ JMP I READSHORT
IPEN, 0 CDF 10 TAD I (7617 /GET NEXT INPUT FILE SNA /BUT IS THERE ONE? JMP ER8 /NO; NO INPUT FILE AND [17 /YES DCA DVNO /GET 4-BIT DEVICE NUMBER TAD I (7617 AND (7760 /GET NEGATIVE OF FILE LENGTH DCA FILEN /0 CASE ? TAD I (7620 /GET STARTING BLOCK OF FILE DCA INREK TAD INHAND IAC DCA ARG$ CDF 0 TAD DVNO CIF 10 JMS I [USR 1 ARG$: 0 JMP ER1 TAD ARG$ DCA INHNDLR JMS REVISE JMP I IPEN /CALL TO RE-OPEN INPUT FILE REVISE, 0 TAD FILEN CIA CLL RTR RTR DCA INLEN TAD INREK DCA INREC TAD (GETOS DCA GETRET JMS READOS STA TAD BUFKNT DCA BUFKNT JMP I REVISE DVNO, 0 /OS/8 INTERNAL DEVICE NUMBER FOR /INPUT DEVICE INHNDLR,HLT /PTR TO INPUT HANDLER ENTRY POINT FILEN, 0
ER1, JMS I [ERROR JMP I [7605 INREK, 0 /START OF INPUT FILE /FIN, JMS GETRET / JMP .-1 /*** CHECK INTO /OPEN AND IPEN CAN BE ONCE-ONLY? ER8, JMS I [ERROR JMP I [7605 PAGE
.SBTTL LISTING AND OUTPUT ROUTINES / JMS LIST / PTR TO ASCII LINE (IN FIELD 1) /THIS ROUTINE IS CALLED TO SEND A STRING OF ASCII CHARACTERS /TO THE LISTING FILE. ARG IS PTR TO STRING WHICH CONSISTS OF /CONSECUTIVE ASCII CHARS (1 PER WORD) TERMINATED /BY A WORD OF 0. AC NON-0 MEANS DON'T CR-LF. /***********************/ / / LISTER, 0 / AND [177 /SAFETY SNA JMP I LSTRET TAD (-11 SNA JMP TAB$ INCR COLCNT A$: TAD (11 JMP I LSTRET / COROUTINE LINKAGE TAB$: TAD COLCNT TAD [10 AND [7770 DCA COLCNT JMP A$ LSTRET, OUTLST / JMP I LISTER / / / /***********************/
CRLF, 0 TAD (15 /PRINT CR/LF JMS LISTER TAD PR12 JMS LISTER DCA COLCNT ISZ LINCNT TAD LINCNT CIA TAD HEIGHT SNA CLA JMS I [NEWPAG JMP I CRLF
OUTLST, CDF 10 DCA I OPTR1 /STORE AWAY FIRST CHAR OF PAIR CDF 0 JMS LSTRET /RETURN TO COROUTINE CDF 10 DCA I OPTR2 /STORE AWAY SECOND CHAR OF PAIR CDF 0 JMS LSTRET /RETURN TO COROUTINE DCA LTEMP /SAVE 3RD CHAR TEMPORARILY TAD LTEMP /GET BACK THIRD CHAR CLL RTL RTL AND [7400 /ISOLATE LEFT HALF OF IT IN BITS 0-3 CDF 10 TAD I OPTR1 /COMBINE WITH CHAR 1 DCA I OPTR1 /STORE BACK IN BUFFER TAD LTEMP /GET 3RD CHAR ONCE MORE CLL RTR PR12, RTR /THIS TIME GET RIGHT HALF RAR AND [7400 /ALSO ISOLATING IN BITS 0-3 TAD I OPTR2 /COMBINE WITH CHAR 2 DCA I OPTR2 /AND STORE BACK IN OUTBUT BUFFER CDF 0 INCR OPTR1 INCR OPTR1 /UPDATE POINTERS TO DOUBLE WORDS INCR OPTR2 INCR OPTR2 ISZ OUTKNT /WAS THIS THE LAST DOUBLE WORD /OF BUFFER? SKP /NO JMS PUTBUF /YES, WRITE OUT LIST BUFFER JMS LSTRET /RETURN TO COROUTINE JMP OUTLST /REITERATE
/OUTPUT LIST BUFFER PUTBUF, 0 TAD OUTBUF CIA TAD [377 TAD OPTR1 AND [7400 STL RAR TAD [10 /FIELD 1 DCA SIZE$ TAD SIZE$ AND [3700 JMS ROTL6 /# OF BLOCKS DCA SIZ$ TAD OUTBUF DCA B$ TAD SIZ$ TAD OUTSIZ DCA OUTSIZ TAD OUTSIZ STL TAD HOLSIZ SNL SZA CLA JMP ER13 JMS I OUTHNDLR SIZE$: 10 B$: 0 /PTS TO OUTPUT BUFFER OUTREC: 0 JMP ER2 TAD OUTREC TAD SIZ$ DCA OUTREC TAD OUTL DCA OUTKNT TAD OUTBUF DCA OPTR1 TAD OPTR1 IAC DCA OPTR2 JMP I PUTBUF SIZ$: 0 /LENGTH JUST WRITTEN ER2, JMS I [ERROR JMP I [7605 LTEMP: 0 OUTHNDLR,0 HOLSIZ, 0 /LENGTH OF HOLE AVAILABLE FOR /OUTPUT FILE (NEGATIVE) ER13, JMS I [ERROR /NO ROOM FOR OUTPUT JMP I [7605 PAGE
PRDOL, 0 /PRINT DOLLAR TAD NAME1 AND [7700 TAD [-7600 SNA CLA JMP XNAME /SPECIAL NAME TAD NAME1 RAL CLL RAR /REMOVE DOLLAR BIT DCA NAME1 TAD (44 /$ JMS PRNT6 JMP I PRDOL XNAME, TAD NAME1 JMS PRNT6 /PRINT PRE-CHAR STA TAD I (DT DCA I (DT /WANT NUMBER AS 4-DIGITS TAD NAME3 SPA CLA /RADIX BIT IS IN AC 0 TAD (DPRINTOPRINT /PRINT NUMBER IN DECIMAL TAD (OPRINT /PRINT NUMBER IN OCTAL DCA XPRINT DCA PAD CLL /WITH NO LEADING 0'S TAD NAME2 JMS I XPRINT TAD NAME3 JMS PRNT6 /PRINT POST-CHAR JMP I (PRTAB /REJOIN PROCESSING XPRINT, 0
FINISH, TAD OUTLEN /# OF BLKS IN OUTPUT BUFFER TAD OUTLEN TAD OUTLEN CLL RTR RTR RTR /# OF WDS IN OUTPUT BUFFER CMA DCA KNT /BY WRITING ^Z FOLLOWED BY ZEROES TAD (32 /^Z JMS I [LISTER /MAKE SURE WRITE ENOUGH TO DUMP /BUFFER ISZ KNT /INCLUDING ^Z JMP .-2 TAD OUTSIZ DCA LEN$ TAD OUTDEV CIF 10 JMS I [USR 4 CLNAME: ONAME LEN$: 1 JMP ER7 CLA IAC /DELETE SYS:KF.TM IF PRSENT CIF 10 JMS I [USR 4 KFNAME 0 CLA /NO ERROR IF NOT THERE JMP I [7605 /CHAIN TO LINKER IF NEC /OR BACK TO KREF'S * ER7, JMS I [ERROR JMP I [7605 KFNAME, FILENAME KF.TM
PRNT2, 0 DCA TEMP$ TAD TEMP$ JMS ROTL6 RAL /ROTATE RIGHT 6 JMS PRNT6 TAD TEMP$ JMS PRNT6 JMP I PRNT2 PRNT6: 0 AND [77 SNA JMP I PRNT6 TAD (-34 SNA TAD (56-34 /CONVERT 34 TO 56 IAC SNA /$ TAD (44-33 /CONVERT 33 TO 44 TAD (33+40 AND [77 TAD [40 JMS I [LISTER JMP I PRNT6 TEMP$: 0 PAGE
/ SBTTL DATE PRINTER DATEWD=7666 /LOCATION OF OS/8 DATE IN FIELD 1 / FORMAT OF OS/8 DATE: / BITS 0-3: 1-14 REPRESENTS JAN-DEC RESP. / BITS 4-8: 1-37 REPRESENTS DAY OF MONTH / BITS 9-11: 0-7 REPRESENTS YEAR - 1970 / THIS ROUTINE CONVERTS OS/8 DATE TO NICE FORM, / I.E. FOODAY, DD-MON-YY / AND INSERTS THESE CHARACTERS (ONE ASCII CHAR PER WORD) / INTO THE HEADER BUFFER / JMS DATE / IF NO DATE WAS IN USE, THE BUFFER IS PADDED WITH BLANKS. / EXACTLY 16 (OCTAL) WORDS ARE SET BY THIS ROUTINE. /THIS ROUTINE OUTPUTS THE DATE IN THE DEC STANDARD FORMAT /FOR OUTPUT REPRESENTATIONS OF DATES.
.SBTTL DATE AND CORE ROUTINES DATE, 0 TAD (DAT-1 DCA XR1 / CDF 10 /GO TO FIELD OF DATE WORD TAD I (DATEWD /GET OS/8 DATE IN INTERNAL FORMAT CDF 0 SNA /IS A DATE SPECIFIED? JMP NODATE /NO, GO PAD BUFFER WITH SPACES DCA TEMP$ /SAVE DATE TEMPORARILY (IN THIS FIELD) TAD TEMP$ /GET BACK DATE (INTERNAL FORM) JMS ROTL6 RAR AND [17 /ISOLATE MONTH IN BITS 8-11 OF AC DCA MONTH$ /SAVE MONTH TAD TEMP$ /LOOK AT INTERNAL REPRESENTATION AGAIN AND [7 /ISOLATE YEAR DCA YEAR$ /SAVE IT TAD I (7777 RTR RTR AND (30 /GET EXTENDED DATE BITS TAD YEAR$ DCA YEAR$ TAD TEMP$ /GET BACK INTERNAL REPRESENTATION CLL RTR RAR AND (37 /ISOLATE DAY OF MONTH DCA DAY$ /SAVE IT STL CLA RTL /2 TAD YEAR$ CLL RTR SNL SMA /IS YEAR A MULTIPLE OF 4? JMP LEAP$ /YES, IT'S A LEAP YEAR! ISZ I (JAN /NO, ITS NOT A LEAP YEAR ISZ I (FEB /FIXUP TABLE FOR NON-LEAP-YEARS LEAP$: AND (37 TAD YEAR$ TAD (3 TAD DAY$ DCA TM4$ TAD MONTH$ TAD (JAN-1 DCA TM3$ TAD I TM3$ TAD TM4$ /DIVIDE THIS NUMBER BY 7 TO GET DAY OF WEEK JMS I [IDIV [7 /DIVIDE BY 7 CLA /IN ORDER TO GET THE REMAINDER TAD REMAIN CLL RAL TAD REMAIN /MULTIPLY BY 3 TAD (DAYLST-1 /GET PTR TO NAME OF DAY OF WEEK JMS I (PUT3 /PUT THESE 3 CHARS IN BUFFER TAD [40 DCA I XR1 /PUT A SPACE IN BUFFER TAD DAY$ /GET DAY OF MONTH BACK JMS I (PUT2 /OUTPUT IT INTO BUFFER AS TWO DECIMAL DIGITS TAD ("- DCA I XR1 /THEN PUT OUT A HYPHEN TAD MONTH$ CLL RAL TAD MONTH$ /MULTIPLY MONTH NUMBER BY 3 TAD (MONLST-4 /GET PTR TO 3-CHAR ABBREVIATION OF MONTH JMS I (PUT3 /PUT IT INTO BUFFER TAD ("- DCA I XR1 /PUT ANOTHER HYPHEN AFTER IT TAD YEAR$ /GET BACK YEAR TAD (106 /ADD 70 (DECIMAL) TO IT JMS I (PUT2 /CONVERT TO TWO DECIMAL DIGITS AND PUT IN BUFFER JMP I DATE /RETURN
NODATE: TAD (-15 /PAD WITH 13 (DECIMAL) SPACES DCA KNT A$: TAD [40 DCA I XR1 /INSERT A SPACE IN THE BUFFER ISZ KNT /DONE? JMP A$ /NO JMP I DATE MONTH$: 0 DAY$: 0 YEAR$: 0 TM4$: 0 TM3$: 0 TEMP$: 0
LIST, 0 DCA FLAG$ /AC NON-0 MEANS DONT CR-LF TAD I LIST /PICK UP ARGUMENT DCA PTR$ /SAVE PTR TO ASCII LINE INCR LIST /POINT TO NORMAL RETURN LOOP$: TAD I PTR$ /GET NEXT CHARACTER SNA /IS THERE ANY MORE? JMP END$ /NO JMS LISTER /YES, SEND TO LIST FILE INCR PTR$ /POINT TO NEXT CHARACTER JMP LOOP$ /REITERATE END$: TAD FLAG$ SNA CLA /DOES CALLER WANT A CR-LF? JMS CRLF /YES JMP I LIST /RETURN FLAG$: 0 /NON-0 MEANS DON'T CRLF AT END PTR$: 0 PAGE
/SUBROUTINE TO DETERMINE REAL PHYSICAL CORE SIZE CORE, 0 TAD I (7777 AND [70 SZA JMP SOFT$ A$: CDF 0 /NEEDED FOR PDP-8L TAD SIZE$ /GET FIELD TO TEST RTL RAL AND COR70 /MASK USEFUL BITS TAD COREX DCA .+1 /SET UP CDF TO FIELD B$: CDF /N /N IS FIELD TO TEST TAD I (CORX /SAVE CURRENT CONTENTS C$: NOP /HACK FOR PDP-8! DCA B$ TAD C$ /7000 IS A "GOOD" PATTERN DCA I (CORX COR70: 70 /HACK FOR PDP-8, NOP TAD I (CORX /TRY TO READ BACK 7000 CORX: 7400 /HACK FOR PDP-8, NOP TAD CORX /GUARD AGAINST WRAP-AROUND TAD (1400 /7000+7400+1400=0 SZA CLA JMP COREX /NON-EXISTENT FIELD EXIT TAD B$ /RESTORE CONTENTS DESTROYED DCA I (CORX ISZ SIZE$ /TRY NEXT HIGHER FIELD JMP A$ COREX: CDF 0 /LEAVE WITH DATA FIELD 0 STA TAD SIZE$ /FIRST NON-EXISTENT FIELD JMP I CORE /RETURN SIZE$: 1 /CURRENT FIELD TO TEST SOFT$: CLL RAR RTR JMP I CORE PAGE
PUT3, 0 /PUT THREE CHARS IN BUFFER DCA XR2 /SAVE PTR TAD I XR2 /GET CHAR DCA I XR1 /PUT IT IN BUFFER TAD I XR2 DCA I XR1 TAD I XR2 DCA I XR1 JMP I PUT3 PUT2, 0 /CONVERT NUMBER IN AC TO 2 DIGITS JMS I [IDIV /DIVIDE AC (12 /BY DECIMAL 10 TAD (60 /CONVERT QUOTIENT TO ASCII DCA I XR1 /PUT IN BUFFER TAD REMAIN /GET REMAINDER TAD (60 /CONVERT IT TO ASCII DCA I XR1 /PUT UNIT'S DIGIT IN BUFFER JMP I PUT2 /RETURN PAGE
.SBTTL UTILITY ROUTINES - BRANCH AND IDIV BRANCH, 0 DCA TEMP$ /SAVE CHAR WHICH WE ARE BRANCHING ON B$: TAD I BRANCH /GET NEXT POSSIBLE CHAR FROM LIST SNA /IS IT ZERO? JMP I BRANCH /YES. END OF LIST. CHAR NOT FOUND /RETURN TO NEXT LOCATION WITH 0 AC. INCR BRANCH /POINT TO ADDRESS ASSOCIATED WITH THIS CHAR TAD TEMP$ /RETRIEVE TEST CHAR SZA CLA /ARE THEY THE SAME? JMP C$ /NO TAD I BRANCH /YES, GET ADDRESS TO WHENCE WE WISH TO JUMP DCA TEMP /STORE IT HERE. JMP I TEMP /THEN JUMP THERE! C$: INCR BRANCH /POINT TO NEXT TEST CHARACTER JMP B$ /AND TEST SOME MORE. TEMP$: 0
/ BOTH IDIV AND IMUL HAVE THE SAME CALLING SEQUENCE /ONE ARGUMENT IS PASSED IN AC /THE OTHER IS POINTED TO BY THE FIRST ARGUMENT /REMAINDER IS LEFT IN 'REMAIN' IDIV, 0 DCA M$ TAD I IDIV DCA K$ TAD I K$ INCR IDIV CIA DCA K$ DCA QUOT$ TAD M$ LOOP$: STL TAD K$ SZL JMP END$ INCR QUOT$ JMP LOOP$ END$: CIA TAD K$ CIA DCA REMAIN /SAVE REMAINDER TAD QUOT$ JMP I IDIV QUOT$: 0 M$: 0 K$: 0 PAGE
.SBTTL BUCKETS AND SYMBOL TABLE STUFF /BUCKETS ARE DETERMINED BY THE FIRST CHARACTER OF THE /NAME OF A WORD, I.E. THERE ARE ROUGHLY 64 BUCKETS. BUKETS, ZBLOCK 100 /AN ENTRY OF 0 MEANS THE BUCKET IS EMPTY. /OTHERWISE, ENTRIES ARE 15-BIT POINTERS. PAGE
/15-BIT POINTERS, HEREAFTER REFERED TO AS 15-BIT POINTERS, /ARE OF THE FORM: / BITS 0-8 12-BIT LOCATION DIVIDED BY 8 / I.E. APPEND 3 ZEROES ON RIGHT TO GET ACTUAL ADDRESS. / ALTERNATIVELY, AND WITH 7770. / BITS 9-11 FIELD OF LOCATION /FREESPACE IS ALLOCATED IN 8-WORD CHUNKS, NOT INCLUDING PAGE 7600 /OF FIELD 0 OR 1 OR 7600 OF FIELD 2 IN CASE OF A TD8E SYSTEM. /FURTHER RESTRICTIONS ARE MADE WHEN RUNNING UNDER BATCH. LIMTBL, INIT;6600 /0 4000;7600 /1 0;7600 /2 0;7760 /3 ****** 5000 OR FIX BATCH INTERACTION 0;0 /4 0;0 /5 0;0 /6 0;7770 /7 CAN'T ALLOW LAST SEGMENT -1 /**** MAKE USR SWAP /THIS TABLE GIVES THE LOWER AND UPPER LIMITS OF CORE AVAILABILITY /IN EACH FIELD. /A FIRST ENTRY OF -1 MEANS THAT FIELD (AND ALL ABOVE IT) IS NOT /AVAILABLE. /EACH CHUNK BEGINS WITH A 15-BIT POINTER TO THE NEXT CHUNK, OR 0 /IF IT IS THE LAST CHUNK IN THE BUCKET. /FREESPACE WILL BE PRE-FORMATTED, I.E. THESE 15-BIT POINTERS /WILL ALREADY EXIST. /IN ADDITION TO BUCKETS, THERE IS A LOCATION 'FREEPTR' WHICH POINTS /TO THE FIRST CHUNK OF AVAILABLE FREE SPACE. IF THIS IS 0, THEN /THERE IS NO MORE FREE SPACE AVAILABLE.
/THIS ROUTINE PRE-FORMATS CORE. PREFORM,0 TAD (INIT+0 DCA FREEPTR TAD FREEPTR AND [7 /ISOLATE STARTING FIELD OF FREESPACE DCA FIELD$ TAD FIELD$ CLL RAL TAD (LIMTBL /POINT INTO LIMIT TABLE TO GET UPPER LIMIT IN THIS FIELD DCA XR1 /XR1 POINTS INTO LIMIT TABLE TAD FREEPTR DCA LPTR A$: CDF 0 TAD I XR1 /GET UPPER LIMIT IN THIS FIELD DCA SUP$ /SAVE IT TAD I XR1 /GET LOWER LIMIT IN NEXT FIELD DCA INF$ /SAVE IT TAD LPTR /GET INITIAL FREE LOCATION JMS I [CNVADR /CONVERT TO 12-BIT PTR B$: DCA LINK$ /SAVE 12-BIT PTR (PTING TO LINKWORD OF CURRENT CHUNK) TAD LINK$ TAD (10 /CHUNKS ARE 8 WORDS LONG DCA NEXT$ /POINT TO NEXT FREE LOCATION IN THIS FIELD TAD NEXT$ CIA TAD SUP$ /ARE WE AT THE LIMITS OF ENDURANCE? SNA CLA JMP END$ /YES, THIS FIELD IS FULL TAD NEXT$ /NO TAD FIELD$ /CONVERT TO 15-BIT POINTER DCA I LINK$ /SET LINK WORD POINTING TO NEXT LOCATION AFTER CHUNK TAD NEXT$ JMP B$ /CONTINUE END$: TAD INF$ /GO TO BEGINNING OF NEXT FIELD CMA /BUF FIRST SEE IF THERE IS A NEXT FIELD SNA /A LIMINF OF -1 MEANS END OF CORE JMP FULL$ /CORE IS FULL CMA /GET NEW 12-BIT LOCATION INCR FIELD$ /IN VERY NEXT FIELD TAD FIELD$ /CONVERT TO 15-BIT POINTER DCA LPTR TAD LPTR DCA I LINK$ /SET LINK WORD OF PREVIOUS ENTRY JMP A$ /REITERATE FOR NEW FIELD FULL$: DCA I LINK$ /0 MEANS NO MORE LINKS, I.E. BUCKET'S END CDF 0 JMP I PREFORM /RETURN
FIELD$: 0 /CURRENT FIELD OF CHUNK NEXT$: 0 /NEXT FREE LOCATION IN THIS FIELD LINK$: 0 /PTS TO LINK WORD IN THIS CHUNK SUP$: 0 /FIRST UNAVAILABLE LOCATION IN THIS FIELD INF$: 0 /FIRST CORE LOCATION IN NEXT FIELD (-1 IF NONE) PAGE
/CNVADR CONVERTS A 15-BIT ADDRESS IN AC TO A 12-BIT ADDRESS /(LEFT IN AC) AND CHANGES TO THE CORRECT DATA FIELD. CNVADR, 0 DCA TEMP$ /SAVE 15-BIT POINTER TAD TEMP$ AND [7 /ISOLATE FIELD CLL RTL RAL /MOVE IT TO BITS 6-8 TAD CDFINSTR /CONVERT TO CDF CHUNK FIELD DCA .+1 HLT /CHANGE TO PROPER DATA FIELD TAD TEMP$ AND (7770 /MASK OUT FIELD OF LOCATION JMP I CNVADR /RETURN WITH 12-BIT PTR IN AC TEMP$: 0 /TEMPORARY
/LOOKUP ROUTINE /CALLED WITH NAME1,NAME2, AND NAME3 ALREADY SET UP / JMS LOOKUP / RETURN IF FOUND (OR ENTERED) / SYMNUM IS 15-BIT PTR TO CHUNK / GOTO 'NORROM' IF NO ROOM TO DO ENTER LOOKUP, 0 CLA IAC DCA FLAG$ TAD NAME1 /GET FIRST TWO CHARS OF NAME JMS CB DCA LPTR /TO GET ACTUAL BUCKET TAD I LPTR /GET FIRST 15-BIT ADDRESS OF BUCKET CHAIN L$: SNA /IS THERE A POINTER? JMP NONE$ /NO. END OF CHAIN DCA CURPTR TAD CURPTR JMS CNVADR /YES, CONVERT TO 12-BIT POINTER DCA PTR$ /SAVE IT TAD PTR$ DCA XR0 TAD I XR0 /GET NEXT ENTRY OF NAME IN CHUNK CLL CIA /NEGATE TAD NAME1 /COMPARE AGAINST CORRESPONDING ENTRY IN GIVEN NAME SZA /ARE THEY EQUAL? JMP FAIL$ /NO TAD I XR0 CLL CIA TAD NAME2 SZA JMP FAIL$ TAD I XR0 CLL CIA TAD NAME3 SZA JMP FAIL$ TAD CURPTR DCA SYMNUM /RETURN 15-BIT PTR IN SYMNUM JMP FND FAIL$: SNL CLA /ARE WE ALPHABETICALLY PAST PROPER SPOT? JMP NONE$ /YES, ITEM NOT FOUND TAD CURPTR DCA SYMNUM DCA FLAG$ TAD I PTR$ JMP L$ CDFINSTR:CDF 0 CURPTR: 0 PTR$: 0
/ENTER ASSUMES LOOKUP JUST FAILED /ASSUMES SYMNUM CONTAINS A 15-BIT PTR TO CHUNK /AFTER WHICH ENTRY IS TO BE INSERTED. /HOWEVER, IF BUKFLG IS NOT 0, THEN LPTR IS A 12-BIT PTR IN FIELD 0. NONE$: CDF 0 TAD FLAG$ SZA CLA JMP B$ TAD SYMNUM JMS CNVADR DCA LPTR B$: TAD I LPTR /LPTR POINTS TO LINK WORD OF PREVIOUS ENTRY DCA TEMP$ /SAVE PTR TO NEXT CHUNK TAD FREEPTR /GET NEW CHUNK FROM FREESPACE SNA JMP I (NOROOM DCA I LPTR /POINT PREVIOUS CHUNK TO THIS NEW CHUNK TAD FREEPTR DCA SYMNUM TAD FREEPTR JMS CNVADR DCA LPTR /GET 12-BIT PTR TO NEW CHUNK TAD I LPTR /GET PTR TO NEXT FREE CHUNK DCA FREEPTR /SAVE IT FOR FUTURE REFERENCE STA TAD LPTR DCA XR1 TAD TEMP$ DCA I XR1 TAD NAME1 DCA I XR1 TAD NAME2 DCA I XR1 TAD NAME3 DCA I XR1 DCA I XR1 DCA I XR1 DCA I XR1 DCA I XR1 FND: CDF 0 JMP I LOOKUP /RETURN TEMP$: 0 /TEMPORARY FLAG$: 0
CB, 0 RTR RTR RTR AND [77 TAD (BUKETS JMP I CB PAGE
.SBTTL TABLEP AND DATA JAN, 0 FEB, 3 4;0;2;5;0;3;6;1;4;6 DAYLST, "S;"A;"T "S;"U;"N "M;"O;"N "T;"U;"E "W;"E;"D "T;"H;"U "F;"R;"I MONLST, "J;"A;"N "F;"E;"B "M;"A;"R "A;"P;"R "M;"A;"Y "J;"U;"N "J;"U;"L "A;"U;"G "S;"E;"P "O;"C;"T "N;"O;"V "D;"E;"C PAGE
/ JMS OPEN OPEN, 0 TAD (7600 DCA OPTR TAD OUTBUF DCA OUTB /GET OUTPUT BUFFER START TAD OUTLEN CLL RTR RTR RTR CIA /NEG OF # OF PAIRS OF WDS IN BUFFER DCA OUTL /GET BUFFER LENGTH CDF 10 TAD I OPTR /GET DEVICE NUMBER SNA /WAS THERE ONE? JMP NOOUT /NO. ASSUME LPT ANDEV, AND [17 /YES. ISOLATE INTERNAL DEVICE # DCA OUTDEV /SAVE LIST DEVICE CDF 10 TAD I OPTR /GET ENTRY AGAIN CDF 0 AND (7760 /THIS TIME ISOLATE LENGTH DCA OUTLN /SAVE INCR OPTR /POINT TO NAME TAD OUTHAND IAC DCA ENT$ /SETUP FOR FETCH OF DEVICE HANDLER TAD OUTDEV /RETRIEVE LISTING DEVICE FILE NUMBER CIF 10 JMS I [USR 1 /FETCH DEVICE HANDLER ENT$: 0 /LOCATION OF 2-PAGE AREA FOR HANDLER /REPLACED BY HANDLER ENTRY POINT JMP ERRLOD /ERROR LOADING HANDLER TAD (ONAME DCA BLK$ /SETUP FOR ENTER TAD (ONAME DCA I (CLNAME CDF 10 TAD I OPTR /LOOK AT FIRST WORD OF NAME SNA /WAS A NAME SPECIFIED? JMP NONAME /NO, PRESUME DEVICE IS NON-FILE /STRUCTURED /COULD CAUSE AN ERROR IF USER NOT /CAREFUL ** DCA ONAME INCR OPTR TAD I OPTR DCA ONAME+1 INCR OPTR TAD I OPTR DCA ONAME+2 INCR OPTR TAD I OPTR SNA /WAS THERE AN EXTENSION? TAD OUTEXT /NO, FORCE ONE DCA ONAME+3 CDF 0 TAD OUTLN /YES TAD OUTDEV /GET DEVICE # AND LENGTH IN AC CIF 10 JMS I [USR /CALL USER SERVICE ROUTINE 3 /TO DO AN ENTER BLK$: 0 /REPLACED BY STARTING BLOCK OF FILE LEN$: 0 /REPLACED BY NEGATIVE OF ACTUAL /LENGTH JMP ENTERR /ERROR WHILE TRYING TO PERFORM AN /ENTER L$: TAD BLK$ DCA I (OUTREC TAD LEN$ DCA I (HOLSIZ TAD ENT$ DCA I (OUTHNDLR TAD (OUTLST DCA I (LSTRET TAD OUTB DCA OPTR1 TAD OUTB IAC DCA OPTR2 TAD OUTL DCA OUTKNT DCA OUTSIZ JMP I OPEN
ERRLOD: CLA HLT ENTERR: CLA HLT NONAME: CDF 0 DCA BLK$ DCA LEN$ TAD OUTDEV TAD (7757 DCA OUTEM$ CDF 10 TAD I OUTEM$ CDF 0 /LOOK AT DCW SPA CLA HLT /TRYING TO WRITE NFS ON FS DEVICE JMP L$ OUTEM$: 0 NOOUT: CDF 0 CIF 10 JMS I [USR 12 /INQUIRE DVI, DEVICE LPT 0 HLT /NO LPT TAD DVI+1 /GET DEVICE # JMP ANDEV PAGE



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