1 TITLE MUDCOM -- MUDDLE SRCCOM (MARC)
22 P=17 ;CANONICAL DM STACK LOCATION
26 PRINTC /MUDCOM for ITS? (Y OR N)/
84 ; FILE NAME DEFINITIONS
115 ESELF==1 ; SELF COMPARISON
116 EILLCH==2 ; ILLEGAL CHARACTER IN FILE NAME
117 ESYNER==3 ; SYNTAX ERROR
118 EOPNFL==4 ; OPEN FAILED
119 EINTER==5 ; INTERNAL BUG IN MUDCOM
120 ENDIFF==6 ; NO DIFFERENCES
121 ENSIM==7 ; NO SIMILARITIES
130 ; TYPE CODES FOR MACRO/MANIFEST HACKS
135 XXXXXX==3 ;DON'T USE THIS!
140 GTYPE: ASCIZ /DEFINE/
155 PTYPE: ASCIZ /FUNCTION/
164 PGTYPE: ASCIZ /FOOBAR/
170 NUMTYP==<<PGTYPE-PTYPE>/2>
171 ; NUMBER OF OBJECT TYPES INTERESTED IN
173 ; MUST BE DEFINED BEFORE USED
207 BIGLOS: 0 ; -1 IF ANY SIMILARITIES ENCOUNTERED
208 SMALOS: 0 ; -1 IF ANY DIFFERENCES ENCOUNTERED
256 DEFINE DBP X ;DECREMENT BYTE POINTER
298 DEFINE CHRADD INST,CHR
306 SUBTTL CHARACTER TABLE
308 CHRTBL: REPEAT 200,JFCL
324 ;START OF MUDCOM CODE
332 STARTX: .SUSET [.RSNAME,,A]
333 MOVEM A,SNAME ;DEFAULT THE SNAMES
337 MOVE MANPTR,[440700,,MANBUF]
338 MOVE CMNPTR,[440700,,CMNBUF]
339 SKIPA E,[440700,,JCLTOP]
340 STARTC: MOVE E,JCLPTR
343 MOVE ENTPTR,[440700,,ENTBUF]
344 MOVE COMPTR,[440700,,COMBUF]
346 PUSHJ P,FPARSS ;GET FIRST NAME
348 PUSHJ P,FPHACK ;HACK THE NAME
350 .CALL DSKOPN ;OPEN A CHANNEL
352 .CALL RCHST ;GET REAL FILE NAMES
360 PUSHJ P,FPARSS ;GET SECOND NAME
362 SKIPN FNAME1(D) ;DEFAULT FNAME1 IF NECESSARY
366 SKIPN SNAME(D) ;DEFAULT SNAME TO FIRST FILE SNAME
374 PUSHJ P,FPHACK ;HACK THE NAME
375 .CALL DSKOPN ;OPEN A CHANNEL
377 .CALL RCHST ;GET REAL FILE NAMES
379 MOVE A,FNAME1 ;SEE IF FIRST NAME IS SECOND NAME
392 SETZ D, ;SELF COMPARISON???
393 OASC [ASCIZ /Asked to compare /]
395 OASCR [ASCIZ / with itself?/]
400 STARTL: OASC [ASCIZ /Listing /]
402 START1: OASC [ASCIZ /Checking /]
411 MOVE MANPTR,[440700,,MANBUF]
412 MOVE CMNPTR,[440700,,CMNBUF]
413 MOVE ENTPTR,[440700,,ENTBUF]
414 MOVE COMPTR,[440700,,COMBUF]
422 ; IF SNAME IS 0, WILL USE CONNECTED DIRECTORY...
423 ; MOVEI A,15. ; GET A BLOCK FOR SNAME
424 ; PUSHJ P,IBLOCK ; IN A
432 SETZM XSNAME' ; GET POINTER TO ASCII SNAME
441 MOVE A,[440700,,JCL] ; INTO JCL BLOCK
444 CAIE B,40 ; FIRST FLUSH LEADING 'MUDCOM '
446 MOVEM A,F1PTR ; SAVE POINTER TO FIRST FILE NAME
448 JUMPE B,TTYJCL ; FUNNY HACK NOW FOR TTY FNM READING
454 CAIE B,", ; FIND SEPARATOR
458 MOVEM A,F2PTR ; AND POINTER TO SECOND FILE NAME
463 HRROM C,GTJFN1+.GJDIR ; DEFAULT THE SNAME
464 MOVE C,[-1,,[ASCIZ /MUD/]]
465 MOVEM C,GTJFN1+.GJEXT ; AND MUD AS SECOND FILE NAME
467 MOVEM C,GTJFN1+.GJGEN
469 JRST JOPNFL ; THIS FILE DOESN'T EXIST -> LOSE
470 MOVEM A,F1JFN ; SAVE THE JFN
472 MOVE B,[440000,,OF%RD]
473 OPENF ; OPEN THE FILE
474 JRST JOPNFL ; WHY? IF GTJFN WON???
477 PUSHJ P,XJFNS ; PARSE THE NAME AND PUT POINTER IN F1BLK
478 SKIPE CHKSW ; FUNNYNESS WITH MUDCHK AND MUDLST
482 PUSHJ P,F1DEF ; FILL DEFAULTS
484 MOVE B,F2PTR ; NOW DO GTJFN, USING DEFAULTS AND JCL
487 MOVEM C,GTJFN1+.GJGEN
489 JRST JOPNFL ; FILE DOESN'T EXIST
490 STT3: MOVEM A,F2JFN ; SAVE JFN HERE ALSO
492 MOVE B,[440000,,OF%RD]
493 OPENF ; OPEN THE FILE
497 PUSHJ P,XJFNS ; PARSE THE FILE NAME AND SAVE IN F2BLK
499 MOVE B,3(A) ; GET FILE NAME 2
501 CAME B,[ASCIZ /MSUBR/]
502 CAMN B,[ASCIZ /TEMP/]
504 CAME B,[ASCIZ /MIMA/]
505 CAMN B,[ASCIZ /NBIN/] ; IS THIS NBIN??
507 JRST START0 ; START THE BALL ROLLING....
509 ;here to find a MUD older than the file given as second file
513 RFTAD ; SAVE CREATION DATE, ETC.
517 MOVSI A,(GJ%OLD+GJ%IFG)
519 MOVEM A,GTJFN1 ; MAKE IT FOO.BAR.*
522 GTJFN ; GET INDEXABLE POINTER
524 MOVEM A,JFN ; AND SAVE THIS
526 JFNLP: HRRZS A ; FLUSH BITS
536 MOVE B,[NBNBLK,,NBNBLK+1]
549 MOVSI A,(GJ%OLD+GJ%SHT)
555 MOVE B,[440000,,OF%RD]
560 PUSHJ P,XJFNS ; PARSE THE FILE NAME AND SAVE IN F2BLK
563 ; FILL DEFAULTS INTO GTJFN BLOCK FROM FILE NAME 1
565 F1DEF: MOVEI B,GTJFN1+.GJDEV
571 AOBJN A,.-3 ; FILL IN NEW DEFAULTS FROM FILE NAME 1
574 XJFNS: MOVE E,[-5,,JFNSBT] ; AOBJN FOR JFNS'ING
579 SETZ D, ; D IS ALWAYS 0 FOR JFNS
584 HRROS A ; POINTER TO STRING
586 MOVE C,(E) ; CORRECT BIT FOR PARSING ONE FIELD
587 JFNS ; PARSE THE NAME
589 AOBJN E,XASKF1 ; UPDATE POINTERS
598 JOPNFL: OASC [ASCIZ /File not found - /]
603 JCLLOS: OASCR [ASCIZ /ERROR - JCL terminated abruptly./]
618 NOJCL: OASCR [ASCIZ /ERROR - JCL must be supplied./]
621 ; HERE TO READ STUFF FROM TTY INSTEAD OF JCL LINE
622 ; MOST OF CODE ABSTRACTED FROM START UP PORTION
624 TTYJCL: OASC [ASCIZ /MUDCOM./]
627 TTYJ0: SKIPE C,XSNAME
628 HRROM C,GTJFN2+.GJDIR
629 MOVE C,[-1,,[ASCIZ /MUD/]]
630 MOVEM C,GTJFN2+.GJEXT
635 HRROI C,[ASCIZ /Compare (FILE) /]
636 MOVEM C,GTJFN2+.GJRTY
639 ANDCAM D,GTJFN2+.GJGEN
644 MOVE B,[440000,,OF%RD]
650 MOVEI B,GTJFN2+.GJDEV
654 HRROI C,[ASCIZ / with (FILE) /]
655 MOVEM C,GTJFN2+.GJRTY
665 TTYJ1: CAIN A,GJFX34 ; ? TYPED
667 CAIN A,GJFX37 ; NULL BUFFER
669 OASC [ASCIZ / ERROR - /]
680 OASCR [ASCIZ /Type in a file name./]
684 OASCR [ASCIZ /Flushed?/]
703 SUBI B,40 ; UPPER CASE
716 OASC [ASCIZ /Illegal switch in JCL - /]
730 JNMCHK: CAMN B,[SIXBIT /MUDCHK/]
737 CAMN B,[SIXBIT /MUDLST/]
744 CAMN B,[SIXBIT /MUDFND/]
745 JRST [MOVE A,[440700,,JCLTOP]
752 START0: SETZ D, ;PRINT TITLE LINES
753 MOVEI A,[ASCIZ /Comparison of /]
755 MOVEI A,[ASCIZ /Preload comparison of /]
765 MOVE A,[10700,,BLKEND-1]
767 ;FIRST PHASE OF COMPARISON, READING IN FIRST FILE
773 PASS1: PUSHJ P,GETSUM
776 JRST [MOVEM B,FTABLE(TMAX)
781 ;SECOND PHASE OF THE COMPARISON, READING SECOND FILE
794 ; SKIPN MANFLG ; TAA 5/5/78 SEEMED TO DIE OTHERWISE: IF
795 ; .CLOSE DSK1, ; CHANGED MANIFEST, WENT TO PASS3 REGARDLESS OF MANFLG
803 PASS2: PUSHJ P,GETSUM
809 MOVE A,[440700,,SYLBUF] ;BUFFER IN A
810 MOVE B,LSTTYP ;TYPE IN B
815 CAME A,(P) ;CHECKSUM IS IN A. ACCESS POINTER IN B. TYPE IN C
826 ;ROUTINES TO PRINT AND RECORD CHANGES
831 OASC [ASCIZ /Removed /]
837 CHGOBJ: OASC [ASCIZ /Changed /]
845 CAIG C,1 ;MAKE FUNCTIONS AND MACROS WIN
851 MOVE F,[440700,,SYLBUF]
873 MOVE A,[440700,,PAKBUF]
879 NEWOBJ: OASC [ASCIZ /New /]
882 OASC [ASCIZ /MANIFEST /]
890 ;THIRD GROSS PASS, FOR MANIFEST AND MACRO HACK
893 SKIPL CMNMAX ; ONLY IF ONE CHANGED
894 SKIPL MANFLG ; BETTER BE LOOKING 7/8/78 (MARC)
906 HALT ; WHY CAN'T ACCESS?
908 MOVE A,[10700,,BLKEND-1]
913 ;FOURTH PASS, FOR REMOVED OBJECTS
915 PASS4: MOVEI A,FTABLE+1
923 ;FINIS. PRINT SUMMARIES
929 CONTI1: PUSHJ P,CLFLAG
931 MOVE [SAVBLK,,FNBLKI]
934 MOVE [ZSTART,,ZSTART+1]
946 UNIMPL: ASCIZ /Unimplemented on the 20. Sorry./
960 SKIPN BIGLOS ; SKIP IF ANY SIMILARITIES
967 FUNCTION MACRO GVAL LVAL
984 HALT ;just halt if not under combat
1002 HALT ; THIS IS WAY TO END LEGIT
1012 EQUAL: OASC [ASCIZ /No differences encountered./]
1019 LOSER: OASC [ASCIZ /No similarities encountered./]
1023 CHKWIN: OASC [ASCIZ /Blessed./]
1029 ;GTNAM GETS THE NAME OF THE SUBR AND IF IT IS ONE WHICH IS HACKED
1030 ;(E.G. DEFINE) IT GETS THE NAME OF THE FUNCTION AND PLACES IT IN
1031 ;THE TABLE WITH THE CORRECT CODE
1039 IMULI C,500. ;FIX UP FOR 500 WORD BLOCKS
1041 ADD C,D ;SUBTRACT THE BP
1043 MOVEM C,LSTPTR ;AND SAVE IT
1044 MOVE B,[440700,,SYLBUF]
1045 PUSHJ P,GETSYL ;GET FIRST ATOM IN FORM
1046 PUSHJ P,GETTYP ;IS IT ONE OF OURS?
1048 SKIPE P2SW ;WINNING ATOM
1051 HRL B,F ;SAVE POINTER TO NAME OF FUNCTION/ATOM
1052 MOVEM B,FTABLE(TMAX)
1053 MOVE C,LSTPTR ;SAVE ACCESS POINTER TO OBJECT
1054 MOVEM C,FTABLE+1(TMAX)
1059 PUSHJ P,GETSYL ;GET NAME OF FUNCTION/ATOM
1067 OASC [ASCIZ /INPUT MACRO /]
1068 PUSHJ P,TYPPRT ;PRINT TYPE
1073 SETOM WINNER ;MARK THAT WE HAVE WON
1080 GETNP2: MOVE B,[440700,,SYLBUF]
1082 PUSHJ P,GETSYL ;GET NAME OF FUNCTION/ATOM AND
1083 SETOM WINNER ;LEAVE IT IN SYLBUF
1090 MOVE B,[440700,,CMNBUF]
1099 OASC [ASCIZ / in file /]
1104 JRST [OASCR [ASCIZ /All present and accounted for./]
1110 ;GETSYL RETURNS A SYLLABLE (ATOM) FROM THE DATA POINTED TO
1111 ;BY A AND PLACES THE SYLLABLE FOLLOWED BY ASCII 0 IN A LOCATION
1114 GETSLF: SKIPA D,[-1]
1124 CAIE C,"[ ; ALLOW OPEN BRACKETS TO WIN HERE
1136 GETSLE: JUMPN D,GETSL2
1145 ;GETTYP CHECKS WHETHER THE SYLLABLE IN SYLBUF MATCHES ANY
1146 ;OF THE KNOWN TYPES (DEFINE, SETG, ETC..) AND SKIP RETURNS
1147 ;IF IT DOES. THE CODE FOR THE MATCHING TYPE IS PLACED IN F.
1149 GETTYP: SETZM MSTGFL'
1158 MOVE B,[440700,,SYLBUF]
1168 JRST [MOVE B,[440700,,SYLBUF]
1191 ;PACKAGE AND ENTRY HACKERY
1199 OASCR [ASCIZ /Quoted ENTRY statement ignored./]
1201 ENTHK1: SETOM FUDGE'
1223 MANHLP: HRRZ B,TBLTOP
1233 MOVEM X,FTABLE(TMAX)
1234 SETOM FTABLE+1(TMAX)
1244 MANHL1: MOVEI F,SETG
1249 MANHK2: MOVE B,[440700,,SYLBUF]
1255 MOVE A,[440700,,SYLBUF]
1259 OASC [ASCIZ /New MANIFEST /]
1267 MOVE A,[440700,,SYLBUF]
1271 JRST [OASC [ASCIZ /New GVAL /]
1279 MANCHR: SETZM MCHRFL'
1299 SKPMAN: MOVEI B,ATOMSK
1331 MOVE B,[440700,,MANBUF]
1335 MANCIN: MOVE A,[440700,,SYLBUF]
1350 RPAKHK: SETOM RPAKSW
1351 PAKHAK: SKIPE MQUOTE
1353 OASCR [ASCIZ /Quoted PACKAGE statement ignored./]
1357 MOVE B,[440700,,PAKBUF]
1376 MOVE A,[440700,,[ASCIZ /!-RPACKAGE/]]
1386 ;ENDPACKAGE ==> RESET POINTERS
1388 EPKHAK: SKIPE MQUOTE
1390 OASCR [ASCIZ /Quoted ENDPACKAGE statement ignored./]
1392 MOVE ENTPTR,[440700,,ENTBUF]
1398 ;ENTRY LOOKUP FUNCTION. EXPECTS ITEM IN SYLBUF.
1399 ;SKIP RETURNS IF SUCCESSFUL
1403 MOVE B,[440700,,ENTBUF]
1404 ENTLIN: MOVE A,[440700,,SYLBUF]
1430 ;MATCHING ROUTINE. A IS A BP TO ITEM TO BE SEARCHED FOR. B IS
1431 ;THE TYPE CODE OF THE ITEM. MATCH SKIPS IF THE ITEM IS FOUND AND
1432 ;RETURNS IN A THE CHECKSUM OF THE ITEM. THE SEARCH ENDS IF ANY
1433 ;TABLE ENTRY IS NOT GREATER THAN ZERO
1434 ;C,D, AND E ARE MUNGED
1436 MATCH: MOVEI X,FTABLE
1443 JRST MATCH2 ;NOT OF SAME TYPE
1444 HRLI C,440700 ;D IS BP TO TABLE ENTRY
1446 MATCH1: ILDB D,C ;GET CHAR FROM TABLE ENTRY
1447 ILDB E,A ;GET CHAR FROM SEARCH ITEM
1449 JRST MATCH2 ;NOT EQUAL ==> LOSE
1450 CAIE E,0 ;BOTH 0 ==> WIN
1453 MOVE A,2(X) ;MOVE CHECKSUM INTO A
1458 MATCH2: ADDI X,RECLEN ;GO TO NEXT ENTRY
1462 ;GETSUM CREATES A CHECKSUM FOR THE MUDDLE OBJECT WHICH IS POINTED
1463 ;TO BY A BP IN A. CHECKSUM IS RETURNED IN B.
1465 ;SKPONE SKIPS OVER ONE MUDDLE OBJECT
1467 SKPONE: MOVEI B,GETSM1
1470 SKPHAK: PUSH P,DEPTH ;SAVE THE CURRENT DEPTH
1471 SETZM DEPTH ;INDICATE TOP LEVEL OBJECT
1472 SETZM MQUOTE ;NO QUOTING
1475 SETOM SKIPPR ;SET SKIP FLAG
1476 PUSHJ P,@ACTIV ;SKIP THE OBJECT
1477 JFCL ;EOF. DONT WORRY
1479 POP P,DEPTH ;RESTORE THE DEPTH
1482 ;FLUSH TOP LEVEL STRINGS
1484 GETSTT: CAIN C,"" ; IGNORE STRINGS AT TOP LEVEL
1502 GETST0: PUSHJ P,GTNAM
1511 GETST1: SETCMM STRSW
1515 ;HERE TO DO THE CHECKSUMMING
1517 GETSUM: SETZM WINNER
1518 MOVE CH,[-100.,,CPDL]
1523 ;PUSHJ TO GETSM1 WITH CORRECT HACKS PERFORMED WILL SKIP OVER ONE
1524 ;OBJECT. SEE SKPONE.
1530 SKIPN DEPTH ;IF DEPTH=0, FIND NEXT OBJECT
1531 PUSHJ P,GETSTT ;START?
1532 GETSM3: SKIPE QUOTSW
1533 JRST EXCLQU ;QUOTE SWITCH SET. CHECK FOR !"\\
1535 JRST QUOTER ;QUOTE ONE CHARACTER
1537 JRST STRING ;TOGGLE STRSW AND CHECK FOR !"
1539 JRST EXCL ;TOGGLE EXCLSW
1541 JRST GETSM2 ;INSIDE STRING. IGNORE BRACKETS, ETC..
1543 GETSM2: SKIPE SKIPPR
1545 ROT B,7 ;ADD IN THE LUCKY CHARACTER
1547 SETSM5: SETZM QUOTSW ;CLEAR RANDOM ONCE ONLY SWITCHES
1552 ;COME HERE IF QUOTE SWITCH IS SET
1553 ;IF BOTH EXCL SWITCH IS SET AND CHAR IS \, GO TO QUOTER (E.G. !"\\)
1554 ;ELSE JUST SNARF ONE CHARACTER AND BE DONE WITH IT
1563 ;COME HERE IF CHARACTER IS A SEPARATOR.
1564 ;FIRST SEP GOES IN AS A SPACE. REST ARE IGNORED
1566 PAD: SKIPN SPACSW ;HACK SEPARATORS CORRECTLY
1571 ROT B,7 ;ADD IN THE LUCKY CHARACTER
1579 ;CHECKSUM THE EXCL AND SET EXCLSW IF NOT IN STRING
1583 ROT B,7 ;ADD IN THE LUCKY CHARACTER
1592 STRING: SKIPE EXCLSW
1593 JRST QUOTER ;MUST BE !"X
1594 SETCMM STRSW ;ELSE TOGGLE STRING MODE
1595 SKIPE STRSW ;ENTERING STRING?
1596 JRST GETSM2 ;YES. CONTINUE.
1597 SKIPN DEPTH ;TOP LEVEL STRING?
1598 JRST POPJ1 ;YES. FINIS.
1599 JRST GETSM2 ;NO. CONTINUE
1603 QUOTER: SKIPE SKIPPR
1605 ROT B,7 ;ADD IN THE LUCKY CHARACTER
1610 ;PUSH AN CLOSED BRACKET CORRESPONDING TO CHAR IN C ON THE CH STACK
1611 ;ALSO PUSH AN ACCESS POINTER TO THE CHAR IN CASE OF SYNTAX ERROR
1613 PUSHER: HRLZ D,ACCPTR
1616 CAIN C,"< ;PUSH ONTO CH WHAT WE WANT BACK
1624 AOS DEPTH ;INCREMENT DEPTH
1627 ;HERE IF CLOSED BRACKET ENCOUNTERED
1628 ;POP THE CH STACK AND COMPARE TO SEE IF WINNING
1632 POP CH,D ;GET LAST PUSHED CHARACTER
1633 CAME B,C ;BETTER BE WHAT WE PUSHED
1634 JRST SYNERR ;OH WELL, CANT WILL EM ALL
1636 SOSLE DEPTH ;DECREMENT DEPTH
1640 ROT B,7 ;ADD IN THE LUCKY CHARACTER
1642 JRST POPJ1 ;DONE ==> WIN
1645 ;NXTBLK READS IN THE NEXT 500 WORDS OF THE INPUT FILE, AND
1646 ;RETURNS IN A A BP TO THE TOP OF THE BLOCK
1648 NXTJCL: SKIPA A,[-500.,,JCLINB]
1649 NXTBLK: MOVE A,[-500.,,INPBLK]
1652 JRST EOFERR ;END OF FILE
1667 MOVE A,[350700,,INPBLK]
1668 POPJ P, ;RETURN BP TO NEW BUFFER IN A
1677 MOVE [-500.,,INPBLK]
1687 MOVE A,[-500.,,INPBLK]
1700 ILLCHR: OASC [ASCIZ /ILLEGAL CHARACTER IN FILE NAME/]
1706 OASC [ASCIZ /SYNTAX ERROR - EOF INSTEAD OF /]
1710 SYNERR: OASC [ASCIZ /SYNTAX ERROR /]
1712 OASC [ASCIZ / INSTEAD OF /]
1718 HLRZ C,FTABLE-2(TMAX)
1720 MOVE C,FTABLE-2(TMAX)
1728 SYNER1: OASCR [ASCIZ /./]
1732 OASC [ASCIZ / [LOC=/]
1733 POP P,D ; PRINT RANGE OF LOSSAGE
1753 Comparison aborted./]
1757 CHKLOS: OASC [ASCIZ /.
1761 SYNLOS: OASC [ASCIZ /What the hell is this file, FORTRAN?/]
1764 OPNFL: OASC [ASCIZ /Open of /]
1766 OASC [ASCIZ / failed./]
1767 OPNFL2: MOVEI B,EOPNFL
1770 OPNFL1: OASC [ASCIZ /Open of the /]
1772 OASC [ASCIZ / directory failed./]
1826 ;RANDOM UTILITY ROUTINES
1828 ;SEP SKIP RETURNS IF THE CHARACTER IN C IS NOT A SEPARATOR
1840 ;TYPPRT PRINTS AN OBJECT TYPE IN C.
1849 ;CORE ALLOCATOR OF A SORT
1851 IBLOCK: ADD A,GCSTOP
1857 ; THIS IS CRETINOUS, BUT WHAT DO YOU EXPECT FROM DEC SOFTWARE?
1863 ; IN (P) IS THE WORD WHICH ITS WOULD LIKE
1868 XIOT: MOVE O,[A,,XACS]
1880 AOS BLKEND ;FUCK THIS
1892 ;ROUTINE TO PARSE FILE NAMES (FROM SHARER)
1895 FPARSE: SETZM NAME ;CLEAR NAME SLOT
1898 MOVE F,[440600,,NAME]
1900 GETCHR: ILDB B,E ;FIND NEXT NON-EMPTY CHARACTER
1916 JRST [PUSHJ P,ASKHAK
1920 JRST [PUSHJ P,FROBOZ
1923 JRST [PUSHJ P,FILJCL
1928 CAIE B,40 ;HERE TO GET A NAME
1930 JRST FNAM ;SPACE AND TAB MAKE FNAME1 AND 2
1933 JRST FNAM ;SO DOES 0 AND <CR>
1945 JRST DEV ;DEVICE NAME
1955 CAIN B,^Q ;HANDLE QUOTING
1957 CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER)
1961 SUBI B,40 ;CASE CONVERSION
1962 TLNE F,770000 ;IGNORE MORE THAN 6 CHARACTERS
1978 DEV: MOVE A,NAME ;SAVE DEVICE
1982 FDIR: MOVE A,NAME ;SAVE SNAME
1988 SKIPE FNAME1(D) ;DOES HE HAVE AN FNAME1 ALREAD?
1989 JRST FNAM1 ;YES - OOPS. HE IS GIVING TWO NAMES
1990 MOVEM A,FNAME1(D) ;NO - TRY IT AS FNAME1
1993 FNAM1: MOVEM A,FNAME2(D) ;PUT NEW NAME INTO FNAME2
1996 ; HERE TO HACK GROSS FIND'AGE IN LIST OF FILES
1998 FROBOZ: SETOM SILENT
2003 FROBCN: SKIPE ENDBRK
2033 FSYNER: SUB P,[1,,1]
2037 FROBOF: OASC [ASCIZ /Open of /]
2039 OASCR [ASCIZ / failed./]
2042 FROBBD: OASC [ASCIZ /Found /]
2046 OASC [ASCIZ / out of /]
2051 ; HERE TO READ JCL FROM A FILE
2061 FILTRM: SUB P,[1,,1] ; FLUSH THIS PUSHJ TO FPARSS
2073 MOVE E,[440700,,JCLINB]
2077 FILOPF: OASC [ASCIZ /Open of /]
2079 OASCR [ASCIZ / failed./]
2082 ; HERE TO GET ATOMS FROM JCL TO BE LOOKED FOR
2084 ASKHAK: SETZM MCHRFL
2101 ASKSEP: SKIPN MCHRFL
2122 ;MOST OF THIS CODE FROM ARCDEV (I.E. FROM ITS)
2124 FPHACK: MOVE X,FNAME2(D)
2128 CAMN X,[SIXBIT /NBIN/]
2130 HAIR: TLNE X,770000 ;LEFT JUSTIFY
2134 HAIR1: LDB F,[301400,,X]
2135 CAMN F,[SIXBIT / <+/]
2137 CAME F,[SIXBIT / >-/]
2138 POPJ P, ;CAN'T HACK THIS
2141 HAIR2: LSH X,6 ;GET RID OF CRUFT
2144 CAIL F,'0 ;GET THE ARGUMENT
2152 TLO B,400000 ;SET BIT
2154 ;4.9 BIT IN B IS SET FOR >
2155 ;RH OF B IS ARGUMENT FOR THE SEARCH
2157 QLOOK: MOVE [-2000,,DIRPAG]
2161 JRST LOST0 ;REPORT INTERNAL BUG
2163 QLOOKR: MOVEI E,DIRPAG+2000-5
2165 PUSH P,[-1] ;BEST INDEX
2166 PUSH P,[SETZ] ;BEST "NUMERIC" PART
2167 PUSH P,[SETZ] ;BEST ALPHA PART
2168 QLOOK4: CAIGE E,DIRPAG
2178 QLOOK8: LDB D,[600,,X]
2181 JRST QLOOK7 ;NOT A DIGIT
2182 QLOK5B: TRNE F,77 ;RIGHT ADJ LOW NON NUM PART
2186 QLOK5A: TLC X,400000 ;AVOID CAM LOSSAGE
2189 JRST QLOK5D ;FIRST MATCH
2190 JUMPGE B,QLOK5E ;GET LEAST
2191 CAMGE X,-1(P) ;GET GREATEST
2196 JRST QLOOK3 ;NOT AS GOOD
2197 QLOK5D: HRRZM E,-2(P)
2200 QLOOK3: SUBI E,LUNBLK
2204 QLOK5E: CAMLE X,-1(P)
2212 QLOOK7: LSHC X,-6 ;LOW DIGIT NOT NUMERIC
2213 JUMPN X,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?)
2214 JUMPL B,QLOK5B ;IF LOOKING FOR GREATEST, LET THIS BE LEAST
2215 MOVNI X,1 ;GREATEST IF LOOKING FOR LEAST
2218 QLOOK2: SUB P,[1,,1]
2219 POP P,C ;BEST "NUMERIC" PART
2224 SOJL D,QFINIS ;KEEP GOING UNTIL REQUEST IS SATISFIED
2227 MOVE F,[SIXBIT /!!!!!!/]
2228 MOVEM F,UFN1(E) ;MUNGE THE DIRECTORY
2229 JRST QLOOKR ;START OVER
2231 QFINIS: POP P,D ;DONE!
2236 ;HERE TO HACK THE NBIN'AGE
2240 MOVE [-2000,,DIRPAG]
2245 MOVEI E,DIRPAG+2000-5
2246 NBNFND: CAIGE E,DIRPAG
2250 CAME X,[SIXBIT /NBIN/]
2254 .CALL DIROPN ; OPEN THE CORRECT DIRECTORY
2256 MOVE [-2000,,DIRPAG]
2259 MOVEI E,DIRPAG+2000-5
2260 NLOOP: CAIGE E,DIRPAG
2265 NLOOP1: TRNE X,77 ;RIGHT JUSTIFY NAME
2269 NLOOP2: LDB D,[600,,X] ;MAKE SURE NAME ENDS IN NUMERIC
2273 NLOOP3: CAMLE B,UNDATE(E) ;COMPARE CREATION DATES
2280 NDONE: JUMPL C,NBNLOS
2287 NONBIN: OASC [ASCIZ /No NBIN file found./]
2290 NLNXT: SUBI E,LUNBLK
2293 NBNNXT: SUBI E,LUNBLK
2298 NBNLOS: OASC [ASCIZ /No file created before NBIN./]
2302 ;PRINT A FILE NAME. CHANNEL NUMBER IS IN D
2305 PFNAME: OSIX DEVICE(D)
2315 PFNAME: MOVE A,F1BLK(D)
2334 ; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)
2343 IRPS X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS]
2356 MOVEI @40 ; GET EFF ADDR. OF UUO
2359 MOVEM UUOD' ; CONTENTS OF EFF ADR
2360 MOVE B,UUOE ; EFF ADR
2361 LDB A,[270400,,40] ; GET UUO AC,
2362 LDB C,[330600,,40] ; OP CODE
2364 MOVEI C,0 ; GRT=>ILLEGAL
2365 JRST @UUOTAB(C) ; GO TO PROPER ROUT
2370 POP P,A ; RESTORE AC'S
2374 ILUUO: .VALUE [ASCIZ /:
\eILLEGAL UUO
\e/]
2382 UOASCR: SKIPA C,[^M] ; CR FOR END OF TYPE
2383 UOASC: MOVEI C,0 ; NO CR
2384 HRLI B,440700 ; MAKE ASCII POINTER
2385 UOASC1: ILDB A,B ; GET CHAR
2386 JUMPE A,.+3 ; FINISH?
2388 JRST .-3 ; AND GET ANOTHER
2389 SKIPN A,C ; GET SAVED CR?
2396 UOASCC: HRLI B,440700 ; MAKE ASCII POINTER
2397 UOAS1C: ILDB A,B ; GET CHAR
2401 JRST UOAS1C ; AND GET ANOTHER
2406 UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE
2411 USXOOP: JUMPE B,UUORET
2418 UOSIXS: MOVE A,[440600,,UUOD]
2433 POWER: 0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000.
2446 UODEC: SKIPA C,[10.] ; GET BASE FOR DECIMAL
2447 UOOCT: MOVEI C,8. ; OCTAL BASE
2448 MOVE B,UUOD ; GET ACTUAL WORD TO PRT
2449 JRST .+3 ; JOIN CODE
2450 UODECI: SKIPA C,[10.] ; DECIMAL
2454 HRREI A,-1 ; A=DIGIT COUNT
2455 PUSHJ P,UONUM ; PRINT NUMBR
2459 HRLM C,(P) ; SAVE DIGIT
2460 SOJE A,UONUM1 ; DONE IF 0
2462 SKIPE B ; - => B=0 => DONE
2463 PUSHJ P,UONUM ; ELSE MORE
2464 UONUM1: HLRZ C,(P) ; RETREIVE DIGITS
2465 ADDI C,"0 ; MAKE TO ASCII
2466 CAILE C,"9 ; IS IT GOOD DIG
2467 ADDI C,"A-"9-1 ; MAKE HEX DIGIT
2518 SETZ [SIXBIT /NUL/]]
2521 COMTTO: .CALL TTYOPN
2542 LOST0: MOVEI B,EINTER
2548 ; DISGUSTITUDE, R.E. MANIFESTS, ETC.
2556 ATOMSK: MOVE CH,[440700,,WRDBUF]
2560 SETOM FUDGE ;TAA 5/31/78 OTHERWISE GOT DEPTH COUNT OFF
2564 JRST AEXCLQ ;QUOTE SWITCH SET. CHECK FOR !"\\
2566 JRST AQUOTE ;QUOTE ONE CHARACTER
2568 JRST ASTRIN ;TOGGLE STRSW AND CHECK FOR !"
2570 JRST AEXCL ;TOGGLE EXCLSW
2572 JRST ATOM2 ;INSIDE STRING. IGNORE BRACKETS, ETC..
2575 CAIE C,40 ;SEP ROUTINE INCLUDED HERE FOR SPEED
2583 ABRACK: CAIE C,"< ;DO THE RIGHT THING WITH BRACKETS
2602 ATMCHR: SETOM INATOM
2604 ATOM2: SETZM QUOTSW ;CLEAR RANDOM ONCE ONLY SWITCHES
2626 ;COME HERE IF CHARACTER IS A SEPARATOR.
2628 APAD: SKIPE SPACSW ;HACK SEPARATORS CORRECTLY
2641 MOVE B,[440700,,CMNBUF]
2642 MOVE A,[440700,,WRDBUF]
2661 MOVEI A,[ASCIZ / [New MANIFEST = /]
2663 MOVEI A,[ASCIZ / [Changed MACRO = /]
2665 MOVEI A,[ASCIZ / [Changed MANIFEST = /]
2667 MOVEI A,[ASCIZ / [Requested ATOM = /]
2676 ; LOOKUP ROUTINE FOR CHANGED MANIFESTS/MACROS
2677 ; SIMILAR TO ENTLKP EXCEPT FOR PAD CODES
2714 ASTRIN: SKIPE EXCLSW
2715 JRST AQUOTE ;MUST BE !"X
2716 SETCMM STRSW ;ELSE TOGGLE STRING MODE
2717 JRST ATOM2 ;NO. CONTINUE
2721 AQUOTE: SETOM QUOTSW