--- /dev/null
+TITLE MUDCOM -- MUDDLE SRCCOM (MARC)
+
+.SYMTAB 8001.
+
+O=0
+F=0
+A=1
+B=2
+C=3
+D=4
+E=5
+X=6
+
+ENTPTR=10
+MANPTR=11
+CMNPTR=12
+COMPTR=13
+
+CH=14
+TMAX=16
+
+P=17 ;CANONICAL DM STACK LOCATION
+
+
+IF1,[ITS==0
+ PRINTC /MUDCOM for ITS? (Y OR N)/
+ .TTYMAC A
+ IFSE A,Y,[ITS==1]
+ TERMIN
+]
+IF1,[
+ IFE ITS,[
+ .TNXDF
+ .DECSAV
+]]
+
+
+
+IFN ITS,[
+LOC 77
+]
+IFE ITS,[
+LOC 140
+]
+JCLTOP: ASCII / /
+JCL: BLOCK 100.
+JNAME: BLOCK 2
+JFNBLK: BLOCK 1000.
+TIMBLK: BLOCK 3
+NBNBLK: BLOCK 25.
+GCSTOP: JFNBLK
+JCLINB: BLOCK 250.
+PDL: BLOCK 30.
+CPDL: BLOCK 100.
+INPBLK: BLOCK 500.
+SYLBUF: BLOCK 10.
+FTABLE: BLOCK 1200.
+PAKBUF: BLOCK 3
+ENTBUF: BLOCK 900.
+COMBUF: BLOCK 400.
+RNDTBL: BLOCK 800.
+MANBUF: BLOCK 800.
+CMNBUF: BLOCK 400.
+DIRPAG: BLOCK 1024.
+PATCH: BLOCK 20.
+
+VERSIO: .FVERS
+BLKEND: 0
+JFN: 0
+F1JFN: 0
+F2JFN: 0
+F1BLK: 0
+F2BLK: 0
+F1PTR: 0
+F2PTR: 0
+FBLOCK: 0
+DSKJFN: 0
+XTABLE: 0
+CMNMAX: -1
+CMNFLG: 0
+MANFLG: 0
+JCLPTR: 0
+
+; FILE NAME DEFINITIONS
+
+UFN1==0
+UFN2==1
+UNDATE==3
+LUNBLK==5
+
+; CHANNEL DEFINITIONS
+
+DSK1==0
+DSK2==1
+TYOC==2
+DSKI==3
+
+; TYPE CODES
+
+DEFMAC==1
+SETG==2
+MSETG==3
+ENTRY==7
+PACKAGE==10
+ENDPACKAGE==11
+RPACKAGE==12
+MANIFEST==13
+
+; FTABLE RECORDS
+
+RECLEN==3
+
+; ERROR CODES
+
+ESELF==1 ; SELF COMPARISON
+EILLCH==2 ; ILLEGAL CHARACTER IN FILE NAME
+ESYNER==3 ; SYNTAX ERROR
+EOPNFL==4 ; OPEN FAILED
+EINTER==5 ; INTERNAL BUG IN MUDCOM
+ENDIFF==6 ; NO DIFFERENCES
+ENSIM==7 ; NO SIMILARITIES
+
+; SEPARATORS
+
+LF==12
+FF==14
+CR==15
+TAB==11
+
+; TYPE CODES FOR MACRO/MANIFEST HACKS
+
+MACPAD==0
+NMNPAD==1
+CMNPAD==2
+XXXXXX==3 ;DON'T USE THIS!
+ASKPAD==4
+
+; TYPE TABLE
+
+GTYPE: ASCIZ /DEFINE/
+ ASCIZ /DEFMAC/
+ ASCIZ /SETG/
+ 0
+ ASCIZ /MSETG/
+ ASCIZ /TITLE/
+ ASCIZ /SUB-ENTRY/
+ ASCIZ /SET/
+ 0
+ ASCIZ /ENTRY/
+ ASCIZ /PACKAGE/
+ ASCIZ /ENDPACKAG/
+ ASCIZ /RPACKAGE/
+ ASCIZ /MANIFEST/
+
+PTYPE: ASCIZ /FUNCTION/
+ ASCIZ /MACRO/
+ ASCIZ /GVAL/
+ 0
+ ASCIZ /MSETG/
+ ASCIZ /CRUFTY/
+ ASCIZ /CRUFTY/
+ ASCIZ /LVAL/
+ 0
+PGTYPE: ASCIZ /FOOBAR/
+ ASCIZ /FOOBAR/
+ ASCIZ /FOOBAR/
+ ASCIZ /FOOBAR/
+ ASCIZ /FOOBAR/
+
+NUMTYP==<<PGTYPE-PTYPE>/2>
+ ; NUMBER OF OBJECT TYPES INTERESTED IN
+MAXTYP==<.-GTYPE>
+ ; MUST BE DEFINED BEFORE USED
+MXGTYP==5
+
+TBLTOP: RNDTBL
+NAME: 0
+FNBLKI:
+FNAME1: 0
+ 0
+FNAME2: SIXBIT />-1/
+ SIXBIT />/
+SNAME: 0
+ 0
+DEVICE: SIXBIT /DSK/
+FNBLKO: 0
+
+HPOS: 0
+
+SAVBLK: 0
+ 0
+ SIXBIT />-1/
+ SIXBIT />/
+ 0
+ 0
+ SIXBIT /DSK/
+ 0
+
+CHGTOT: BLOCK NUMTYP
+NEWTOT: BLOCK NUMTYP
+REMTOT: BLOCK NUMTYP
+SAMTOT: BLOCK NUMTYP
+
+ZSTART:
+P2SW: 0
+P3SW: 0
+BIGLOS: 0 ; -1 IF ANY SIMILARITIES ENCOUNTERED
+SMALOS: 0 ; -1 IF ANY DIFFERENCES ENCOUNTERED
+
+PRELOD: 0
+
+LSTPTR: 0
+LSTTYP: 0
+
+CURCHN: 0
+
+DEPTH: 0
+
+WINNER: 0
+SPACSW: 0
+
+CHKSW: 0
+
+COMCNT: 0
+PAKSW: 0
+RPAKSW: 0
+MQUOTE: 0
+MMACRO: 0
+SKIPPR: 0
+
+TOTSW: 0
+GETSW: 0
+STRSW: 0
+QUOTSW: 0
+ENDSW: 0
+EXCLSW: 0
+
+ENDFLG: 0
+ZFINIS:
+LSTFLG: 0
+
+
+COMSW: 0
+ACCPTR: -1
+ACCSAV: 0
+
+DEFINE HALT
+IFN ITS,[
+ .BREAK 16,140000
+]
+IFE ITS,[
+ JRST XHALT
+]
+TERMIN
+
+DEFINE DBP X ;DECREMENT BYTE POINTER
+ ADD X,[070000,,0]
+ JUMPGE X,.+3
+ SOS X
+ HRLI X,010700
+TERMIN
+
+DEFINE SAFEIN AC,
+ PUSH P,A
+ MOVE AC,ACCPTR
+ MOVEM AC,ACCSAV
+TERMIN
+
+DEFINE SAFEOUT AC,
+ MOVE AC,ACCSAV
+ CAMN AC,ACCPTR
+ JRST .+3
+ PUSHJ P,LSTBLK
+ JRST .-3
+ POP P,A
+TERMIN
+
+DEFINE NXTCHR X
+ IBP A
+ HRRZ A
+ CAML BLKEND
+ PUSHJ P,NXTBLK
+ LDB X,A
+ JUMPL X,EOFERR
+TERMIN
+
+DEFINE COMCHR CHR
+ MOVEI CHR
+ IDPB COMPTR
+ AOS COMCNT
+TERMIN
+
+DEFINE COMAC AC,
+ IDPB AC,COMPTR
+ AOS COMCNT
+TERMIN
+
+DEFINE CHRADD INST,CHR
+ZZZ==.
+ LOC CHRTBL+CHR
+ JRST INST
+LOC ZZZ
+TERMIN
+
+\f
+SUBTTL CHARACTER TABLE
+
+CHRTBL: REPEAT 200,JFCL
+
+CHRADD PAD,40
+CHRADD PAD,TAB
+CHRADD PAD,CR
+CHRADD PAD,LF
+CHRADD PAD,FF
+CHRADD PUSHER,"<
+CHRADD PUSHER,"(
+CHRADD PUSHER,"[
+CHRADD PUSHER,"{
+CHRADD POPPER,")
+CHRADD POPPER,"}
+CHRADD POPPER,"]
+CHRADD POPPER,">
+
+;START OF MUDCOM CODE
+
+IFN ITS,[
+START: CAIA
+ JRST COMBAT
+ .CALL TTYOPN
+ .VALUE
+ .BREAK 12,[5,,JCL]
+STARTX: .SUSET [.RSNAME,,A]
+ MOVEM A,SNAME ;DEFAULT THE SNAMES
+ MOVE P,[-30,,PDL-1]
+ .SUSET [.RJNAME,,B]
+ PUSHJ P,JNMCHK
+ MOVE MANPTR,[440700,,MANBUF]
+ MOVE CMNPTR,[440700,,CMNBUF]
+ SKIPA E,[440700,,JCLTOP]
+STARTC: MOVE E,JCLPTR
+ SKIPE FROBSW
+ JRST FROBCN
+ MOVE ENTPTR,[440700,,ENTBUF]
+ MOVE COMPTR,[440700,,COMBUF]
+ SETZ D,
+ PUSHJ P,FPARSS ;GET FIRST NAME
+ PUSH P,E
+ PUSHJ P,FPHACK ;HACK THE NAME
+ POP P,E
+ .CALL DSKOPN ;OPEN A CHANNEL
+ JRST OPNFL
+ .CALL RCHST ;GET REAL FILE NAMES
+ .LOSE 1000
+ SKIPE CHKSW
+ JRST START1
+ SKIPE LSTFLG
+ JRST STARTL
+ MOVEI D,1
+ SKIPN ENDBRK
+ PUSHJ P,FPARSS ;GET SECOND NAME
+ MOVEM E,JCLPTR
+ SKIPN FNAME1(D) ;DEFAULT FNAME1 IF NECESSARY
+ JRST [MOVE A,FNAME1
+ MOVEM A,FNAME1(D)
+ JRST .+1]
+ SKIPN SNAME(D) ;DEFAULT SNAME TO FIRST FILE SNAME
+ JRST [MOVE A,SNAME
+ MOVEM A,SNAME(D)
+ JRST .+1]
+ SKIPN DEVICE(D)
+ JRST [MOVE A,DEVICE
+ MOVEM A,DEVICE(D)
+ JRST .+1]
+ PUSHJ P,FPHACK ;HACK THE NAME
+ .CALL DSKOPN ;OPEN A CHANNEL
+ JRST OPNFL
+ .CALL RCHST ;GET REAL FILE NAMES
+ .LOSE 1000
+ MOVE A,FNAME1 ;SEE IF FIRST NAME IS SECOND NAME
+ CAME A,FNAME1+1
+ JRST START0
+ MOVE A,FNAME2
+ CAME A,FNAME2+1
+ JRST START0
+ MOVE A,SNAME
+ CAME A,SNAME+1
+ JRST START0
+ MOVE A,DEVICE
+ CAME A,DEVICE+1
+ JRST START0
+
+ SETZ D, ;SELF COMPARISON???
+ OASC [ASCIZ /Asked to compare /]
+ PUSHJ P,PFNAME
+ OASCR [ASCIZ / with itself?/]
+ MOVEI B,ESELF
+ JRST LOST
+
+]
+STARTL: OASC [ASCIZ /Listing /]
+ CAIA
+START1: OASC [ASCIZ /Checking /]
+ PUSHJ P,PFNAME
+ OASCR [ASCIZ /./]
+ JRST START2
+
+IFE ITS,[
+START: CAIA
+ SETOM COMSW
+ MOVE P,[-30,,PDL-1]
+ MOVE MANPTR,[440700,,MANBUF]
+ MOVE CMNPTR,[440700,,CMNBUF]
+ MOVE ENTPTR,[440700,,ENTBUF]
+ MOVE COMPTR,[440700,,COMBUF]
+ SETO A,
+ MOVE B,[-1,,E]
+ MOVEI C,.JISNM
+ GETJI
+ JFCL
+ MOVE B,E
+ PUSHJ P,JNMCHK
+; IF SNAME IS 0, WILL USE CONNECTED DIRECTORY...
+; MOVEI A,15. ; GET A BLOCK FOR SNAME
+; PUSHJ P,IBLOCK ; IN A
+; PUSH P,A
+; GJINF
+; HLL B,A
+; HRRO A,(P)
+; DIRST ; HERE IT IS
+; JFCL
+; POP P,A
+ SETZM XSNAME' ; GET POINTER TO ASCII SNAME
+ SETZ A,
+ RSCAN
+ JFCL
+ JUMPE A,TTYJCL
+ MOVN C,A
+ MOVEI A,.PRIIN
+ MOVE B,[440700,,JCL]
+ SIN ; READ JCL
+ MOVE A,[440700,,JCL] ; INTO JCL BLOCK
+ ILDB B,A ; PARSE IT
+ JUMPE B,TTYJCL
+ CAIE B,40 ; FIRST FLUSH LEADING 'MUDCOM '
+ JRST .-3
+ MOVEM A,F1PTR ; SAVE POINTER TO FIRST FILE NAME
+STT1: ILDB B,A
+ JUMPE B,TTYJCL ; FUNNY HACK NOW FOR TTY FNM READING
+ CAIN B,"/
+ PUSHJ P,XSWTCH
+ SKIPN CHKSW
+ SKIPE LSTFLG
+ JRST STT2
+ CAIE B,", ; FIND SEPARATOR
+ JRST STT1
+ MOVEI B,0
+ DPB B,A
+ MOVEM A,F2PTR ; AND POINTER TO SECOND FILE NAME
+STT2: MOVEI A,GTJFN1
+ MOVE B,F1PTR
+ MOVEM B,FPTR'
+ SKIPE C,XSNAME
+ HRROM C,GTJFN1+.GJDIR ; DEFAULT THE SNAME
+ MOVE C,[-1,,[ASCIZ /MUD/]]
+ MOVEM C,GTJFN1+.GJEXT ; AND MUD AS SECOND FILE NAME
+ MOVSI C,(GJ%OLD)
+ MOVEM C,GTJFN1+.GJGEN
+ GTJFN ; GET THE JFN
+ JRST JOPNFL ; THIS FILE DOESN'T EXIST -> LOSE
+ MOVEM A,F1JFN ; SAVE THE JFN
+ MOVEM A,JFN
+ MOVE B,[440000,,OF%RD]
+ OPENF ; OPEN THE FILE
+ JRST JOPNFL ; WHY? IF GTJFN WON???
+ MOVEI A,F1BLK
+ MOVEM A,FBLOCK
+ PUSHJ P,XJFNS ; PARSE THE NAME AND PUT POINTER IN F1BLK
+ SKIPE CHKSW ; FUNNYNESS WITH MUDCHK AND MUDLST
+ JRST START1
+ SKIPE LSTFLG
+ JRST STARTL
+ PUSHJ P,F1DEF ; FILL DEFAULTS
+ MOVEI A,GTJFN1
+ MOVE B,F2PTR ; NOW DO GTJFN, USING DEFAULTS AND JCL
+ MOVEM B,FPTR
+ MOVSI C,(GJ%OLD)
+ MOVEM C,GTJFN1+.GJGEN
+ GTJFN
+ JRST JOPNFL ; FILE DOESN'T EXIST
+STT3: MOVEM A,F2JFN ; SAVE JFN HERE ALSO
+ MOVEM A,JFN
+ MOVE B,[440000,,OF%RD]
+ OPENF ; OPEN THE FILE
+ JRST JOPNFL ; WHY?
+ MOVEI A,F2BLK
+ MOVEM A,FBLOCK
+ PUSHJ P,XJFNS ; PARSE THE FILE NAME AND SAVE IN F2BLK
+ MOVE A,F2BLK
+ MOVE B,3(A) ; GET FILE NAME 2
+ MOVE B,(B) ; INTO AC
+ CAME B,[ASCIZ /MSUBR/]
+ CAMN B,[ASCIZ /TEMP/]
+ JRST FOONM2
+ CAME B,[ASCIZ /MIMA/]
+ CAMN B,[ASCIZ /NBIN/] ; IS THIS NBIN??
+ JRST FOONM2
+ JRST START0 ; START THE BALL ROLLING....
+
+;here to find a MUD older than the file given as second file
+FOONM2: MOVE A,F2JFN
+ MOVEI B,TIMBLK
+ MOVEI C,2
+ RFTAD ; SAVE CREATION DATE, ETC.
+ MOVE A,TIMBLK+.RSCRV
+ MOVEM A,NBNTIM'
+ PUSHJ P,F1DEF
+ MOVSI A,(GJ%OLD+GJ%IFG)
+ HRRI A,-3
+ MOVEM A,GTJFN1 ; MAKE IT FOO.BAR.*
+ MOVEI A,GTJFN1
+ SETZ B,
+ GTJFN ; GET INDEXABLE POINTER
+ HALT
+ MOVEM A,JFN ; AND SAVE THIS
+ SETZ D,
+JFNLP: HRRZS A ; FLUSH BITS
+ MOVEI B,TIMBLK
+ MOVEI C,2
+ RFTAD
+ MOVE B,TIMBLK+.RSCRV
+ CAMG B,NBNTIM
+ CAMGE B,BSTTIM'
+ JRST NXTJFN
+ MOVEM B,BSTTIM
+ SETZM NBNBLK
+ MOVE B,[NBNBLK,,NBNBLK+1]
+ BLT B,NBNBLK+24.
+ MOVE B,A
+ HRROI A,NBNBLK
+ SETZ C,
+ JFNS
+NXTJFN: MOVE A,JFN
+ GNJFN
+ CAIA
+ JRST JFNLP
+
+ SKIPN BSTTIM
+ JRST NBNLOS
+ MOVSI A,(GJ%OLD+GJ%SHT)
+ HRROI B,NBNBLK
+ GTJFN
+ HALT ; WENT AWAY?
+ MOVEM A,F2JFN
+ MOVEM A,JFN
+ MOVE B,[440000,,OF%RD]
+ OPENF
+ HALT ; WHY?
+ MOVEI A,F2BLK
+ MOVEM A,FBLOCK
+ PUSHJ P,XJFNS ; PARSE THE FILE NAME AND SAVE IN F2BLK
+ JRST START0
+
+; FILL DEFAULTS INTO GTJFN BLOCK FROM FILE NAME 1
+
+F1DEF: MOVEI B,GTJFN1+.GJDEV
+F1DEF1: MOVE A,F1BLK
+ HRLI A,-5
+ HRRO C,(A)
+ MOVEM C,(B)
+ AOJ B,
+ AOBJN A,.-3 ; FILL IN NEW DEFAULTS FROM FILE NAME 1
+ POPJ P,
+
+XJFNS: MOVE E,[-5,,JFNSBT] ; AOBJN FOR JFNS'ING
+ MOVEI A,6
+ PUSHJ P,IBLOCK
+ MOVEM A,@FBLOCK
+ MOVE X,A
+ SETZ D, ; D IS ALWAYS 0 FOR JFNS
+XASKF1: MOVEI A,15.
+ PUSHJ P,IBLOCK
+ HRLI A,15.
+ MOVEM A,(X)
+ HRROS A ; POINTER TO STRING
+ MOVE B,JFN ; JFN
+ MOVE C,(E) ; CORRECT BIT FOR PARSING ONE FIELD
+ JFNS ; PARSE THE NAME
+ AOJ X,
+ AOBJN E,XASKF1 ; UPDATE POINTERS
+ POPJ P,
+
+JFNSBT: JS%DEV
+ JS%DIR
+ JS%NAM
+ JS%TYP
+ JS%GEN
+
+JOPNFL: OASC [ASCIZ /File not found - /]
+ MOVE A,FPTR
+ OBPTR A
+ HALT
+
+JCLLOS: OASCR [ASCIZ /ERROR - JCL terminated abruptly./]
+ HALT
+
+GTJFN1: GJ%OLD
+ .NULIO,,.NULIO
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+
+NOJCL: OASCR [ASCIZ /ERROR - JCL must be supplied./]
+ HALT
+
+; HERE TO READ STUFF FROM TTY INSTEAD OF JCL LINE
+; MOST OF CODE ABSTRACTED FROM START UP PORTION
+
+TTYJCL: OASC [ASCIZ /MUDCOM./]
+ ODEC VERSIO
+ OASCR [0]
+TTYJ0: SKIPE C,XSNAME
+ HRROM C,GTJFN2+.GJDIR
+ MOVE C,[-1,,[ASCIZ /MUD/]]
+ MOVEM C,GTJFN2+.GJEXT
+ MOVEI A,GTJFN2
+ SETZ B,
+ MOVEI D,.
+ MOVEM D,GTACT'
+ HRROI C,[ASCIZ /Compare (FILE) /]
+ MOVEM C,GTJFN2+.GJRTY
+ OASC (C)
+ MOVSI D,(GJ%CFM)
+ ANDCAM D,GTJFN2+.GJGEN
+ GTJFN
+ JRST TTYJ1
+ MOVEM A,JFN
+ MOVEM A,F1JFN
+ MOVE B,[440000,,OF%RD]
+ OPENF
+ HALT
+ MOVEI A,F1BLK
+ MOVEM A,FBLOCK
+ PUSHJ P,XJFNS
+ MOVEI B,GTJFN2+.GJDEV
+ PUSHJ P,F1DEF1
+ MOVEI D,.
+ MOVEM D,GTACT
+ HRROI C,[ASCIZ / with (FILE) /]
+ MOVEM C,GTJFN2+.GJRTY
+ OASC (C)
+ MOVSI D,(GJ%CFM)
+ IORM D,GTJFN2+.GJGEN
+ MOVEI A,GTJFN2
+ SETZ B,
+ GTJFN
+ JRST TTYJ1
+ JRST STT3
+
+TTYJ1: CAIN A,GJFX34 ; ? TYPED
+ JRST TTYHLP
+ CAIN A,GJFX37 ; NULL BUFFER
+ JRST TTYNUL
+ OASC [ASCIZ / ERROR - /]
+ MOVEI A,.PRIOU
+ MOVE B,[SETZ -1]
+ SETZ C,
+ ERSTR
+ JFCL
+ JFCL
+ OASCR [0]
+ JRST TTYJ0
+
+TTYHLP: OASCR [0]
+ OASCR [ASCIZ /Type in a file name./]
+ JRST @GTACT
+
+TTYNUL: OASCR [0]
+ OASCR [ASCIZ /Flushed?/]
+ JRST TTYJ0
+
+GTJFN2: GJ%OLD
+ .PRIIN,,.PRIOU
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ G1%RND+<20000,,0>+3
+ 0
+ 0
+ 0
+
+XSWTCH: ILDB B,A
+ CAIL B,"a
+ SUBI B,40 ; UPPER CASE
+ CAIN B,"T
+ JRST [SETOM TOTSW
+ JRST XSW1]
+ CAIN B,"C
+ JRST [SETOM CHKSW
+ JRST XSW1]
+ CAIN B,"M
+ JRST [SETOM MANFLG
+ JRST XSW1]
+ CAIN B,"L
+ JRST [SETOM LSTFLG
+ JRST XSW1]
+ OASC [ASCIZ /Illegal switch in JCL - /]
+ OASCI (B)
+ OASCR [ASCIZ /./]
+ POPJ P,
+
+XSW1: ILDB B,A
+ JUMPE B,JCLLOS
+ CAIN B,40
+ JRST XSW1
+ DBP A
+ MOVEM A,F1PTR
+ POPJ P,
+]
+
+JNMCHK: CAMN B,[SIXBIT /MUDCHK/]
+ JRST [SETOM CHKSW
+IFN ITS,[
+ MOVE A,[SIXBIT />/]
+ MOVEM A,FNAME2
+]
+ JRST .+1]
+ CAMN B,[SIXBIT /MUDLST/]
+ JRST [SETOM LSTFLG
+IFN ITS,[
+ MOVE A,[SIXBIT />/]
+ MOVEM A,FNAME2
+]
+ JRST .+1]
+ CAMN B,[SIXBIT /MUDFND/]
+ JRST [MOVE A,[440700,,JCLTOP]
+ MOVEI B,"(
+ IDPB B,A
+ SETOM FNDFLG'
+ JRST .+1]
+ POPJ P,
+
+START0: SETZ D, ;PRINT TITLE LINES
+ MOVEI A,[ASCIZ /Comparison of /]
+ SKIPE PRELOD
+ MOVEI A,[ASCIZ /Preload comparison of /]
+ SKIPN COMSW
+ OASC (A)
+ PUSHJ P,PFNAME
+ OASC [ASCIZ / and /]
+ MOVEI D,1
+ PUSHJ P,PFNAME
+ OASCR [ASCIZ /./]
+START2: MOVEI A,DSK1
+ MOVEM A,CURCHN
+ MOVE A,[10700,,BLKEND-1]
+
+;FIRST PHASE OF COMPARISON, READING IN FIRST FILE
+
+IFE ITS,[
+ MOVE A,F1JFN
+ MOVEM A,DSKJFN
+]
+PASS1: PUSHJ P,GETSUM
+ JRST PASS02
+ SKIPE WINNER
+ JRST [MOVEM B,FTABLE(TMAX)
+ AOJA TMAX,PASS1]
+ JRST PASS1
+
+\f
+;SECOND PHASE OF THE COMPARISON, READING SECOND FILE
+
+PASS02:
+IFE ITS,[
+ MOVE A,F2JFN
+ MOVEM A,DSKJFN
+]
+ SKIPE FROBSW
+ JRST CONTI1
+ SKIPE CHKSW
+ JRST CHKWIN
+ SKIPE LSTFLG
+ JRST LSTWIN
+; SKIPN MANFLG ; TAA 5/5/78 SEEMED TO DIE OTHERWISE: IF
+; .CLOSE DSK1, ; CHANGED MANIFEST, WENT TO PASS3 REGARDLESS OF MANFLG
+ MOVEI A,DSK2
+ MOVEM A,CURCHN
+ SETOM P2SW
+ PUSHJ P,CLFLAG
+ PUSHJ P,NXTBLK
+ HRLI A,440700
+
+PASS2: PUSHJ P,GETSUM
+ JRST PASS3
+ SKIPN WINNER
+ JRST PASS2
+ PUSH P,A
+ PUSH P,B
+ MOVE A,[440700,,SYLBUF] ;BUFFER IN A
+ MOVE B,LSTTYP ;TYPE IN B
+ PUSHJ P,MATCH
+ JRST [PUSHJ P,NEWOBJ
+ JRST P2ENDR]
+ SETOM BIGLOS
+ CAME A,(P) ;CHECKSUM IS IN A. ACCESS POINTER IN B. TYPE IN C
+ JRST [PUSHJ P,CHGOBJ
+ JRST P2ENDR]
+ AOSA SAMTOT(C)
+
+P2ENDR: OASCR [0]
+P2END: POP P,B
+ POP P,A
+ JRST PASS2
+
+\f
+;ROUTINES TO PRINT AND RECORD CHANGES
+
+REMOBJ: HLRZ C,-1(A)
+ SETOM SMALOS
+ AOS REMTOT(C)
+ OASC [ASCIZ /Removed /]
+ PUSHJ P,TYPPRT
+ MOVE B,-1(A)
+ OASCR (B)
+ JRST P3END
+
+CHGOBJ: OASC [ASCIZ /Changed /]
+ AOS CHGTOT(C)
+ CAIN C,DEFMAC
+ PUSHJ P,MACHAK
+ CAIN C,SETG
+ JRST [SKIPE MANFLG
+ PUSHJ P,MANCHK
+ JRST .+1]
+ CAIG C,1 ;MAKE FUNCTIONS AND MACROS WIN
+ SKIPN COMSW
+ JRST NEWOB1
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE F,[440700,,SYLBUF]
+GH1: ILDB A,F
+ JUMPE A,GH2
+ COMAC A,
+ JRST GH1
+
+GH2: SKIPN PAKSW
+ JRST GH3
+ PUSHJ P,ENTLKP
+ JRST ADDTR
+ SKIPN RPAKSW
+ JRST GH3
+ COMCHR "!
+ COMCHR "-
+GH3: COMCHR 40
+ POP P,C
+ POP P,B
+ POP P,A
+ JRST NEWOB1
+
+ADDTR: COMCHR "!
+ COMCHR "-
+ MOVE A,[440700,,PAKBUF]
+ADDTR1: ILDB B,A
+ JUMPE B,GH3
+ COMAC B,
+ JRST ADDTR1
+
+NEWOBJ: OASC [ASCIZ /New /]
+ AOS NEWTOT(C)
+NEWOB1: SKIPE CMNFLG
+ OASC [ASCIZ /MANIFEST /]
+ SETZM CMNFLG
+ PUSHJ P,TYPPRT
+ OASC SYLBUF
+ SETOM SMALOS
+ POPJ P,
+
+\f
+;THIRD GROSS PASS, FOR MANIFEST AND MACRO HACK
+
+PASS3: SETOM P3SW
+ SKIPL CMNMAX ; ONLY IF ONE CHANGED
+ SKIPL MANFLG ; BETTER BE LOOKING 7/8/78 (MARC)
+ JRST PASS4
+ SETZM ENDFLG
+ MOVEI A,DSK1
+ MOVEM A,CURCHN
+IFN ITS,[
+ .ACCESS DSK1,[0]
+]
+IFE ITS,[
+ MOVE A,F1JFN
+ SETZ B,
+ SFPTR
+ HALT ; WHY CAN'T ACCESS?
+]
+ MOVE A,[10700,,BLKEND-1]
+ PUSHJ P,ATOM
+ JRST PASS4
+ JRST .-2
+
+;FOURTH PASS, FOR REMOVED OBJECTS
+
+PASS4: MOVEI A,FTABLE+1
+ MOVE B,(A)
+ JUMPE B,FINIS
+ JUMPGE B,REMOBJ
+P3END: ADDI A,RECLEN
+ JRST PASS4+1
+
+\f
+;FINIS. PRINT SUMMARIES
+
+WINEND: POP P,
+ POPJ P,
+
+CONTIN: OASCR [0]
+CONTI1: PUSHJ P,CLFLAG
+ SETZ TMAX,
+ MOVE [SAVBLK,,FNBLKI]
+ BLT FNBLKO
+ SETZM ZSTART
+ MOVE [ZSTART,,ZSTART+1]
+ BLT ZFINIS
+ MOVEI RNDTBL
+ MOVEM TBLTOP
+IFN ITS,[
+ JRST STARTC
+]
+IFE ITS,[
+ OASC UNIMPL
+ HALT
+]
+
+UNIMPL: ASCIZ /Unimplemented on the 20. Sorry./
+
+CLFLAG: SETZM ENDFLG
+ SETZM SPACSW
+ SETZM GETSW
+ SETZM STRSW
+ SETZM QUOTSW
+ SETZM ENDSW
+ SETZM EXCLSW
+ SETOM ACCPTR
+ POPJ P,
+
+FINIS: SKIPE PRELOD
+ JRST CONTIN
+ SKIPN BIGLOS ; SKIP IF ANY SIMILARITIES
+ JRST LOSER
+ SKIPN SMALOS
+ JRST EQUAL
+ SKIPN TOTSW
+ JRST FINIS1
+ OASC [ASCIZ /
+ FUNCTION MACRO GVAL LVAL
+SAME/]
+ MOVEI D,SAMTOT
+ PUSHJ P,TOTAL
+ OASC [ASCIZ /
+CHANGED/]
+ MOVEI D,CHGTOT
+ PUSHJ P,TOTAL
+ OASC [ASCIZ /
+NEW/]
+ MOVEI D,NEWTOT
+ PUSHJ P,TOTAL
+ OASC [ASCIZ /
+REMOVED/]
+ MOVEI D,REMTOT
+ PUSHJ P,TOTAL
+FINIS1: SKIPN COMSW
+ HALT ;just halt if not under combat
+
+ SETZ A,
+ SKIPN B,COMCNT
+ MOVEI A,10
+IFN ITS,[
+ MOVEI C,COMBUF
+]
+IFE ITS,[
+ PUSH P,A
+ HRROI A,COMBUF
+ RSCAN
+ JFCL
+ SETZ A,
+ RSCAN
+ JFCL
+ POP P,A
+]
+ HALT ; THIS IS WAY TO END LEGIT
+
+TOTAL: MOVEI C,4
+ HRLI D,-NUMTYP
+TOTLP: ADDI C,6
+ OHPOS (C)
+ OALIGN 4,(D)
+ AOBJN D,TOTLP
+ POPJ P,
+
+EQUAL: OASC [ASCIZ /No differences encountered./]
+ MOVEI A,6
+ MOVEI C,COMBUF
+ HALT
+
+;MY FAVORITE!
+
+LOSER: OASC [ASCIZ /No similarities encountered./]
+ MOVEI A,7
+ HALT
+
+CHKWIN: OASC [ASCIZ /Blessed./]
+ HALT
+
+LSTWIN: HALT
+
+\f
+;GTNAM GETS THE NAME OF THE SUBR AND IF IT IS ONE WHICH IS HACKED
+;(E.G. DEFINE) IT GETS THE NAME OF THE FUNCTION AND PLACES IT IN
+;THE TABLE WITH THE CORRECT CODE
+
+GTNAM: AOS OBJCNT'
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,F
+ MOVE C,ACCPTR
+ IMULI C,500. ;FIX UP FOR 500 WORD BLOCKS
+ HRRZ D,A
+ ADD C,D ;SUBTRACT THE BP
+ SUBI C,INPBLK+1
+ MOVEM C,LSTPTR ;AND SAVE IT
+ MOVE B,[440700,,SYLBUF]
+ PUSHJ P,GETSYL ;GET FIRST ATOM IN FORM
+ PUSHJ P,GETTYP ;IS IT ONE OF OURS?
+ JRST GETEND ;LOSE
+ SKIPE P2SW ;WINNING ATOM
+ JRST GETNP2
+ HRRZ B,TBLTOP
+ HRL B,F ;SAVE POINTER TO NAME OF FUNCTION/ATOM
+ MOVEM B,FTABLE(TMAX)
+ MOVE C,LSTPTR ;SAVE ACCESS POINTER TO OBJECT
+ MOVEM C,FTABLE+1(TMAX)
+ ADDI TMAX,2
+ HRLI B,440700
+ PUSH P,B
+ PUSH P,F
+ PUSHJ P,GETSYL ;GET NAME OF FUNCTION/ATOM
+ POP P,C
+ POP P,D
+ SKIPE FROBSW
+ PUSHJ P,FROBCH
+ SKIPN LSTFLG
+ JRST GETNPR
+ SKIPE MMACRO
+ OASC [ASCIZ /INPUT MACRO /]
+ PUSHJ P,TYPPRT ;PRINT TYPE
+ OBPTR D ;AND NAME
+ OASCR [0]
+GETNPR: ADDI B,1
+ HRRM B,TBLTOP
+ SETOM WINNER ;MARK THAT WE HAVE WON
+GETEND: POP P,F
+ POP P,D
+ POP P,C
+ POP P,B
+ POPJ P,
+
+GETNP2: MOVE B,[440700,,SYLBUF]
+ MOVEM F,LSTTYP
+ PUSHJ P,GETSYL ;GET NAME OF FUNCTION/ATOM AND
+ SETOM WINNER ;LEAVE IT IN SYLBUF
+ JRST GETEND
+
+FROBCH: PUSH P,A
+ PUSH P,B
+ MOVEM C,LSTTYP
+ MOVE A,D
+ MOVE B,[440700,,CMNBUF]
+ MOVEI 3
+ IDPB CMNPTR
+ PUSHJ P,ATMLKP
+ JRST [POP P,B
+ JRST POPDAJ]
+ MOVE C,LSTTYP
+ PUSHJ P,TYPPRT
+ OBPTR A
+ OASC [ASCIZ / in file /]
+ SETZ D,
+ PUSHJ P,PFNAME
+ OASCR [ASCIZ /./]
+ SOSG CMNSAV
+ JRST [OASCR [ASCIZ /All present and accounted for./]
+ HALT
+]
+ POP P,B
+ JRST POPDAJ
+\f
+;GETSYL RETURNS A SYLLABLE (ATOM) FROM THE DATA POINTED TO
+;BY A AND PLACES THE SYLLABLE FOLLOWED BY ASCII 0 IN A LOCATION
+;POINTED TO BY B
+
+GETSLF: SKIPA D,[-1]
+GETSYL: SETZ D,
+ SETZM GETSW
+GTNAM1: NXTCHR C
+ CAIN C,";
+ PUSHJ P,SKPMAN
+ PUSHJ P,SEP
+ JRST GETSL1
+ CAIN C,""
+ JRST GETSL1
+ CAIE C,"[ ; ALLOW OPEN BRACKETS TO WIN HERE
+ CAIN C,"{
+ JRST GETSL1
+ CAIE C,"(
+ CAIN C,"<
+ JRST GETSL1
+ CAIN C,">
+ JRST GETSLE
+ SETOM GETSW
+ IDPB C,B
+ JRST GTNAM1
+
+GETSLE: JUMPN D,GETSL2
+GETSL1: SKIPN GETSW
+ JRST GTNAM1
+GETSL2: MOVEI F,0
+ IDPB F,B
+ DBP A
+ POPJ P,
+
+\f
+;GETTYP CHECKS WHETHER THE SYLLABLE IN SYLBUF MATCHES ANY
+;OF THE KNOWN TYPES (DEFINE, SETG, ETC..) AND SKIP RETURNS
+;IF IT DOES. THE CODE FOR THE MATCHING TYPE IS PLACED IN F.
+
+GETTYP: SETZM MSTGFL'
+ PUSH P,A
+ MOVEI A,GTYPE-2
+ SETO F,
+GETLP1: ADDI F,1
+ CAIN F,MAXTYP
+ JRST POPAJ
+ ADDI A,2
+ HRLI A,440700
+ MOVE B,[440700,,SYLBUF]
+GETLP2: ILDB C,A
+ ILDB D,B
+ CAME C,D
+ JRST GETLP1
+ JUMPE D,GETLP3
+ JRST GETLP2
+
+GETLP3: POP P,A
+ SKIPE P3SW
+ JRST [MOVE B,[440700,,SYLBUF]
+ PUSHJ P,GETSYL
+ POPJ P,]
+ CAIN F,MSETG
+ JRST [SETOM MSTGFL
+ JRST MANHAK]
+ CAIG F,MXGTYP
+ JRST POPJ1
+ CAIN F,MANIFEST
+ JRST MANHAK
+ SKIPE P2SW
+ POPJ P,
+ CAIN F,ENTRY
+ JRST ENTHAK
+ CAIN F,PACKAGE
+ JRST PAKHAK
+ CAIN F,RPACKAGE
+ JRST RPAKHK
+ CAIN F,ENDPACKAGE
+ JRST EPKHAK
+ POPJ P,
+
+\f
+;PACKAGE AND ENTRY HACKERY
+
+;ENTRY STATEMENT
+
+ENTHAK: SKIPN PAKSW
+ POPJ P,
+ SKIPE MQUOTE
+ JRST [SKIPN SILENT
+ OASCR [ASCIZ /Quoted ENTRY statement ignored./]
+ POPJ P,]
+ENTHK1: SETOM FUDGE'
+ENTCHR: NXTCHR B
+ CAIN B,";
+ PUSHJ P,SKPONE
+ CAIN B,">
+ POPJ P,
+ CAIE B,15
+ CAIN B,12
+ SETZ B,
+ CAIE B,11
+ CAIN B,"
+ SETZ B,
+ IDPB B,ENTPTR
+ JRST ENTCHR
+
+MANHAK: SETOM FUDGE
+ SAFEIN B,
+ PUSHJ P,MANCHR
+ SAFEOUT B,
+ SKIPE P2SW
+ JRST MANHK2
+
+MANHLP: HRRZ B,TBLTOP
+ HRLI B,MANIFEST
+ MOVE X,B
+ HRLI B,440700
+ SAFEIN C,
+ PUSHJ P,GETSLF
+ SKIPN GETSW
+ JRST POPSJ
+ ADDI B,1
+ HRRM B,TBLTOP
+ MOVEM X,FTABLE(TMAX)
+ SETOM FTABLE+1(TMAX)
+ ADDI TMAX,RECLEN
+ SKIPE MSTGFL
+ JRST MANHL1
+ SUB P,[1,,1]
+ JRST MANHLP
+
+POPSJ: SUB P,[1,,1]
+ POPJ P,
+
+MANHL1: MOVEI F,SETG
+ SETZM FUDGE
+ SAFEOUT C,
+ JRST POPJ1
+
+MANHK2: MOVE B,[440700,,SYLBUF]
+ SETZM FUDGE
+ PUSHJ P,GETSLF
+ SKIPN GETSW
+ POPJ P,
+ PUSH P,A
+ MOVE A,[440700,,SYLBUF]
+ MOVEI B,MANIFEST
+ PUSHJ P,MATCH
+ JRST [PUSHJ P,MNFOO
+ OASC [ASCIZ /New MANIFEST /]
+ OASCR SYLBUF
+ AOS CMNMAX
+ JRST .+1]
+ POP P,A
+ SKIPN MSTGFL
+ JRST MANHK2
+ PUSH P,A
+ MOVE A,[440700,,SYLBUF]
+ MOVEI B,SETG
+ MOVEM B,LSTTYP
+ PUSHJ P,MATCH
+ JRST [OASC [ASCIZ /New GVAL /]
+ OASCR SYLBUF
+ JRST POPAJ]
+ POP P,A
+ SUB P,[1,,1]
+ SETOM WINNER
+ JRST GETEND
+
+MANCHR: SETZM MCHRFL'
+ SETZM MPADFL'
+MANCHL: NXTCHR B
+ CAIN B,";
+ PUSHJ P,SKPMAN
+ CAIN B,">
+ JRST [SETZ B,
+ IDPB B,MANPTR
+ POPJ P,]
+ CAIE B,15
+ CAIN B,12
+ JRST MPAD
+ CAIE B,11
+ CAIN B,40
+ JRST MPAD
+ SETOM MCHRFL
+ SETZM MPADFL
+MPUT: IDPB B,MANPTR
+ JRST MANCHL
+
+SKPMAN: MOVEI B,ATOMSK
+ MOVEM B,ACTIV
+ JRST SKPHAK
+
+MPAD: SKIPN MCHRFL
+ JRST MANCHL
+ SKIPE MPADFL
+ JRST MANCHL
+ SETOM MPADFL
+ SETZ B,
+ SKIPN MSTGFL
+ JRST MPUT
+ IDPB B,MANPTR
+ POPJ P,
+
+MNFOO: PUSH P,D
+ MOVEI D,NMNPAD
+ JRST MACHK1
+MACHAK: PUSH P,D
+ MOVEI D,MACPAD
+MACHK1: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ JRST MANCIN
+
+MANCHK: PUSH P,D
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI D,CMNPAD
+ MOVEI B,3
+ IDPB B,MANPTR
+ MOVE B,[440700,,MANBUF]
+ PUSHJ P,ENTLIN
+ JRST MANOUT
+ SETOM CMNFLG
+MANCIN: MOVE A,[440700,,SYLBUF]
+ MOVE C,CMNPTR
+MANLP: ILDB B,A
+ IDPB B,CMNPTR
+ JUMPN B,MANLP
+ IDPB D,CMNPTR
+ AOS CMNMAX
+MANOUT: POP P,C
+ POP P,B
+ POP P,A
+ POP P,D
+ POPJ P,
+
+;PACKAGE STATEMENT
+
+RPAKHK: SETOM RPAKSW
+PAKHAK: SKIPE MQUOTE
+ JRST [SKIPN SILENT
+ OASCR [ASCIZ /Quoted PACKAGE statement ignored./]
+ POPJ P,]
+ SETOM PAKSW
+ PUSH P,A
+ MOVE B,[440700,,PAKBUF]
+ MOVEI C,"I
+ IDPB C,B
+ COMCHR ""
+PAKHK1: ILDB C,A
+ CAIN C,">
+ JRST PAKEND
+ PUSHJ P,SEP
+ JRST PAKHK1
+ CAIN C,""
+ JRST PAKHK1
+ IDPB C,B
+ COMAC C,
+ JRST PAKHK1
+
+PAKEND: COMCHR ""
+ COMCHR 40
+ SKIPN RPAKSW
+ JRST PENDL1
+ MOVE A,[440700,,[ASCIZ /!-RPACKAGE/]]
+PENDLP: ILDB C,A
+ JUMPE C,PENDL1
+ IDPB C,B
+ JRST PENDLP
+
+PENDL1: SETZ C,
+ IDPB C,B
+ JRST POPAJ
+
+;ENDPACKAGE ==> RESET POINTERS
+
+EPKHAK: SKIPE MQUOTE
+ JRST [SKIPN SILENT'
+ OASCR [ASCIZ /Quoted ENDPACKAGE statement ignored./]
+ POPJ P,]
+ MOVE ENTPTR,[440700,,ENTBUF]
+ SETZM PAKBUF
+ SETZM PAKSW
+ POPJ P,
+
+\f
+;ENTRY LOOKUP FUNCTION. EXPECTS ITEM IN SYLBUF.
+;SKIP RETURNS IF SUCCESSFUL
+
+ENTLKP: MOVEI B,3
+ IDPB B,ENTPTR
+ MOVE B,[440700,,ENTBUF]
+ENTLIN: MOVE A,[440700,,SYLBUF]
+ PUSH P,A
+ENTL0: ILDB D,B
+ JUMPE D,.-1
+ CAIN D,3
+ JRST POPAJ
+ SKIPA A,(P)
+ENTL1: ILDB D,B
+ ILDB C,A
+ CAME C,D
+ JRST ENTL2
+ CAIE C,0
+ JRST ENTL1
+ ILDB C,B
+ SETOM MACFLG'
+ JUMPE C,.+2
+ SETZM MACFLG
+ JRST POPAJ1
+
+ENTL2: ILDB C,B
+ JUMPE C,ENTL0
+ CAIE C,3
+ JRST ENTL2
+ JRST POPAJ
+
+\f
+;MATCHING ROUTINE. A IS A BP TO ITEM TO BE SEARCHED FOR. B IS
+;THE TYPE CODE OF THE ITEM. MATCH SKIPS IF THE ITEM IS FOUND AND
+;RETURNS IN A THE CHECKSUM OF THE ITEM. THE SEARCH ENDS IF ANY
+;TABLE ENTRY IS NOT GREATER THAN ZERO
+;C,D, AND E ARE MUNGED
+
+MATCH: MOVEI X,FTABLE
+ PUSH P,A
+MATCH0: SKIPG C,(X)
+ JRST [MOVE C,B
+ JRST POPAJ] ;LOST
+ HLRZ F,C
+ CAME F,B
+ JRST MATCH2 ;NOT OF SAME TYPE
+ HRLI C,440700 ;D IS BP TO TABLE ENTRY
+ MOVE A,(P)
+MATCH1: ILDB D,C ;GET CHAR FROM TABLE ENTRY
+ ILDB E,A ;GET CHAR FROM SEARCH ITEM
+ CAME D,E
+ JRST MATCH2 ;NOT EQUAL ==> LOSE
+ CAIE E,0 ;BOTH 0 ==> WIN
+ JRST MATCH1
+ POP P,A
+ MOVE A,2(X) ;MOVE CHECKSUM INTO A
+ MOVE C,B ;TYPE CODE
+ MOVSI B,400000
+ IORB B,1(X)
+ JRST POPJ1 ;RETURN
+MATCH2: ADDI X,RECLEN ;GO TO NEXT ENTRY
+ JRST MATCH0
+
+\f
+;GETSUM CREATES A CHECKSUM FOR THE MUDDLE OBJECT WHICH IS POINTED
+;TO BY A BP IN A. CHECKSUM IS RETURNED IN B.
+;C GETS CLOBBERED
+;SKPONE SKIPS OVER ONE MUDDLE OBJECT
+
+SKPONE: MOVEI B,GETSM1
+ MOVEM B,ACTIV
+
+SKPHAK: PUSH P,DEPTH ;SAVE THE CURRENT DEPTH
+ SETZM DEPTH ;INDICATE TOP LEVEL OBJECT
+ SETZM MQUOTE ;NO QUOTING
+ SETZM MMACRO
+ SETZ B,
+ SETOM SKIPPR ;SET SKIP FLAG
+ PUSHJ P,@ACTIV ;SKIP THE OBJECT
+ JFCL ;EOF. DONT WORRY
+ SETZM SKIPPR
+ POP P,DEPTH ;RESTORE THE DEPTH
+ POPJ P, ;AND RETURN
+
+;FLUSH TOP LEVEL STRINGS
+
+GETSTT: CAIN C,"" ; IGNORE STRINGS AT TOP LEVEL
+ JRST GETST1
+ SKIPE STRSW
+ JRST GETST0
+ CAIE C,"(
+ CAIN C,"{
+ POPJ P,
+ CAIN C,"[
+ POPJ P,
+ CAIN C,"'
+ JRST [SETOM MQUOTE
+ JRST GETST0]
+ CAIN C,"%
+ JRST [SETOM MMACRO
+ JRST GETST0]
+ CAIE C,"<
+ JRST [SUB P,[1,,1]
+ JRST @ACTIV]
+GETST0: PUSHJ P,GTNAM
+ SETZM MQUOTE
+ SETZM MMACRO
+ SETZ B,
+ SKIPE FUDGE
+ MOVEI C,40
+ SETZM FUDGE
+ POPJ P,
+
+GETST1: SETCMM STRSW
+ SUB P,[1,,1]
+ JRST @ACTIV
+
+;HERE TO DO THE CHECKSUMMING
+
+GETSUM: SETZM WINNER
+ MOVE CH,[-100.,,CPDL]
+ SETZM DEPTH
+ MOVEI X,GETSM1
+ MOVEM X,ACTIV'
+
+;PUSHJ TO GETSM1 WITH CORRECT HACKS PERFORMED WILL SKIP OVER ONE
+;OBJECT. SEE SKPONE.
+
+GETSM1: NXTCHR C
+ SKIPN STRSW
+ SKIPE SKIPPR
+ JRST GETSM3
+ SKIPN DEPTH ;IF DEPTH=0, FIND NEXT OBJECT
+ PUSHJ P,GETSTT ;START?
+GETSM3: SKIPE QUOTSW
+ JRST EXCLQU ;QUOTE SWITCH SET. CHECK FOR !"\\
+ CAIN C,"\
+ JRST QUOTER ;QUOTE ONE CHARACTER
+ CAIN C,""
+ JRST STRING ;TOGGLE STRSW AND CHECK FOR !"
+ CAIN C,"!
+ JRST EXCL ;TOGGLE EXCLSW
+ SKIPE STRSW
+ JRST GETSM2 ;INSIDE STRING. IGNORE BRACKETS, ETC..
+ XCT CHRTBL(C)
+GETSM2: SKIPE SKIPPR
+ JRST SETSM5
+ ROT B,7 ;ADD IN THE LUCKY CHARACTER
+ XOR B,C
+SETSM5: SETZM QUOTSW ;CLEAR RANDOM ONCE ONLY SWITCHES
+ SETZM EXCLSW
+ SETZM SPACSW
+ JRST GETSM1 ;NEXT
+
+;COME HERE IF QUOTE SWITCH IS SET
+;IF BOTH EXCL SWITCH IS SET AND CHAR IS \, GO TO QUOTER (E.G. !"\\)
+;ELSE JUST SNARF ONE CHARACTER AND BE DONE WITH IT
+
+EXCLQU: CAIN C,"\
+ SKIPN EXCLSW
+ JRST GETSM2
+ SETZM EXCLSW
+ JRST QUOTER
+
+
+;COME HERE IF CHARACTER IS A SEPARATOR.
+;FIRST SEP GOES IN AS A SPACE. REST ARE IGNORED
+
+PAD: SKIPN SPACSW ;HACK SEPARATORS CORRECTLY
+ JRST [SETOM SPACSW
+ MOVEI C,40
+ SKIPE SKIPPR
+ JRST .+3
+ ROT B,7 ;ADD IN THE LUCKY CHARACTER
+ XOR B,C
+ SETZM QUOTSW
+ SETZM EXCLSW
+ JRST GETSM1]
+ JRST GETSM1
+
+;HANDLE EXCL
+;CHECKSUM THE EXCL AND SET EXCLSW IF NOT IN STRING
+
+EXCL: SKIPE SKIPPR
+ JRST .+3
+ ROT B,7 ;ADD IN THE LUCKY CHARACTER
+ XOR B,C
+ SKIPE STRSW
+ JRST GETSM2
+ SETOM EXCLSW
+ JRST GETSM1
+
+;HANDLE STRINGAGE
+
+STRING: SKIPE EXCLSW
+ JRST QUOTER ;MUST BE !"X
+ SETCMM STRSW ;ELSE TOGGLE STRING MODE
+ SKIPE STRSW ;ENTERING STRING?
+ JRST GETSM2 ;YES. CONTINUE.
+ SKIPN DEPTH ;TOP LEVEL STRING?
+ JRST POPJ1 ;YES. FINIS.
+ JRST GETSM2 ;NO. CONTINUE
+
+;QUOTE A CHARACTER
+
+QUOTER: SKIPE SKIPPR
+ JRST .+3
+ ROT B,7 ;ADD IN THE LUCKY CHARACTER
+ XOR B,C
+ SETOM QUOTSW
+ JRST GETSM1
+
+;PUSH AN CLOSED BRACKET CORRESPONDING TO CHAR IN C ON THE CH STACK
+;ALSO PUSH AN ACCESS POINTER TO THE CHAR IN CASE OF SYNTAX ERROR
+
+PUSHER: HRLZ D,ACCPTR
+ HRR D,A
+ PUSH CH,D
+ CAIN C,"< ;PUSH ONTO CH WHAT WE WANT BACK
+ PUSH CH,[">]
+ CAIN C,"[
+ PUSH CH,["]]
+ CAIN C,"(
+ PUSH CH,[")]
+ CAIN C,"{
+ PUSH CH,["}]
+ AOS DEPTH ;INCREMENT DEPTH
+ JRST GETSM2
+
+;HERE IF CLOSED BRACKET ENCOUNTERED
+;POP THE CH STACK AND COMPARE TO SEE IF WINNING
+
+POPPER: PUSH P,B
+ POP CH,B
+ POP CH,D ;GET LAST PUSHED CHARACTER
+ CAME B,C ;BETTER BE WHAT WE PUSHED
+ JRST SYNERR ;OH WELL, CANT WILL EM ALL
+ POP P,B
+ SOSLE DEPTH ;DECREMENT DEPTH
+ JRST GETSM2
+ SKIPE SKIPPR
+ JRST .+3
+ ROT B,7 ;ADD IN THE LUCKY CHARACTER
+ XOR B,C
+ JRST POPJ1 ;DONE ==> WIN
+
+\f
+;NXTBLK READS IN THE NEXT 500 WORDS OF THE INPUT FILE, AND
+;RETURNS IN A A BP TO THE TOP OF THE BLOCK
+
+NXTJCL: SKIPA A,[-500.,,JCLINB]
+NXTBLK: MOVE A,[-500.,,INPBLK]
+ MOVE A
+ SKIPE ENDFLG
+ JRST EOFERR ;END OF FILE
+IFN ITS,[
+ .CALL DSKIOT
+ .LOSE 1000 ;WHY?
+ AOS ACCPTR
+ JUMPGE .+2
+ SETOM ENDFLG
+ HRRZM BLKEND
+]
+IFE ITS,[
+ PUSHJ P,XIOTI
+ A
+ SETOM ENDFLG
+ AOS ACCPTR
+]
+ MOVE A,[350700,,INPBLK]
+ POPJ P, ;RETURN BP TO NEW BUFFER IN A
+
+LSTBLK: PUSH P,A
+ SOSGE A,ACCPTR
+ HALT ;HUH?
+ IMULI A,500.
+IFN ITS,[
+ .CALL DSKACC
+ .LOSE 1000
+ MOVE [-500.,,INPBLK]
+ .CALL DSKIOT
+ .LOSE 1000
+]
+IFE ITS,[
+ PUSH P,B
+ MOVE B,A
+ MOVE A,DSKJFN
+ SFPTR
+ HALT ; HUH?
+ MOVE A,[-500.,,INPBLK]
+ PUSHJ P,XIOTI
+ A
+ JFCL
+]
+ HRRZM BLKEND
+ SETZM ENDFLG
+ POP P,B
+ JRST POPAJ
+
+\f
+;ERROR HANDLERS
+
+ILLCHR: OASC [ASCIZ /ILLEGAL CHARACTER IN FILE NAME/]
+ MOVEI B,EILLCH
+ JRST LOST
+
+EOFERR: SKIPN DEPTH
+ JRST WINEND
+ OASC [ASCIZ /SYNTAX ERROR - EOF INSTEAD OF /]
+ OASCI @(CH)
+ JRST SYNER1
+
+SYNERR: OASC [ASCIZ /SYNTAX ERROR /]
+ OASCI (C)
+ OASC [ASCIZ / INSTEAD OF /]
+ OASCI (B)
+ OASC [ASCIZ / in /]
+ SKIPN CURCHN
+ JRST [SKIPN TMAX
+ JRST SYNLOS
+ HLRZ C,FTABLE-2(TMAX)
+ PUSHJ P,TYPPRT
+ MOVE C,FTABLE-2(TMAX)
+ OASC (C)
+ JRST SYNER1]
+ MOVE C,LSTTYP
+ SKIPN TMAX
+ JRST SYNLOS
+ PUSHJ P,TYPPRT
+ OASC SYLBUF
+SYNER1: OASCR [ASCIZ /./]
+ PUSH P,D
+ MOVE D,CURCHN
+ PUSHJ P,PFNAME
+ OASC [ASCIZ / [LOC=/]
+ POP P,D ; PRINT RANGE OF LOSSAGE
+ HLRZ C,D
+ IMULI C,500.
+ ADDI C,(D)
+ SUBI C,INPBLK
+ IMULI C,5
+ ODEC C
+ OASCI ",
+ MOVE C,ACCPTR
+ IMULI C,500.
+ ADDI C,(A)
+ SUBI C,INPBLK
+ IMULI C,5
+ ODEC C
+ OASCI "]
+ SKIPE FJCLSW
+ JRST FSYNER
+ SKIPE CHKSW
+ JRST CHKLOS
+ OASC [ASCIZ /.
+Comparison aborted./]
+ MOVEI B,ESYNER
+ JRST LOST
+
+CHKLOS: OASC [ASCIZ /.
+Check aborted./]
+ JRST LOST
+
+SYNLOS: OASC [ASCIZ /What the hell is this file, FORTRAN?/]
+ HALT
+
+OPNFL: OASC [ASCIZ /Open of /]
+ PUSHJ P,PFNAME
+ OASC [ASCIZ / failed./]
+OPNFL2: MOVEI B,EOPNFL
+ JRST LOST
+
+OPNFL1: OASC [ASCIZ /Open of the /]
+ OASC SNAME(D)
+ OASC [ASCIZ / directory failed./]
+ JRST OPNFL2
+
+\f
+;RANDOM CALL BLOCKS
+
+TTYOPN: SETZ
+ SIXBIT /OPEN/
+ 5000,,4001
+ MOVEI TYOC
+ SETZ [SIXBIT /TTY/]
+
+DSKOPN: SETZ
+ SIXBIT /OPEN/
+ 5000,,2
+ D
+ DEVICE(D)
+ FNAME1(D)
+ FNAME2(D)
+ SETZ SNAME(D)
+
+RCHST: SETZ
+ SIXBIT /RCHST/
+ D
+ MOVEM DEVICE(D)
+ MOVEM FNAME1(D)
+ MOVEM FNAME2(D)
+ SETZM SNAME(D)
+
+DIROPN: SETZ
+ SIXBIT /OPEN/
+ 5000,,6
+ MOVEI DSKI
+ DEVICE(D)
+ [SIXBIT /.FILE./]
+ [SIXBIT /(DIR)/]
+ SETZ SNAME(D)
+
+DIRIOT: SETZ
+ SIXBIT /IOT/
+ MOVEI DSKI
+ SETZ
+
+DSKACC: SETZ
+ SIXBIT /ACCESS/
+ CURCHN
+ SETZ A
+
+DSKIOT: SETZ
+ SIXBIT /IOT/
+ CURCHN
+ SETZ
+
+\f
+;RANDOM UTILITY ROUTINES
+
+;SEP SKIP RETURNS IF THE CHARACTER IN C IS NOT A SEPARATOR
+
+SEP: CAIE C,40
+ CAIN C,TAB
+ POPJ P,
+ CAIE C,CR
+ CAIN C,LF
+ POPJ P,
+ CAIN C,FF
+ POPJ P,
+ JRST POPJ1
+
+;TYPPRT PRINTS AN OBJECT TYPE IN C.
+
+TYPPRT: IMULI C,2
+ OASC PTYPE(C)
+ OASCI 40
+ POPJ P,
+
+\f
+
+;CORE ALLOCATOR OF A SORT
+
+IBLOCK: ADD A,GCSTOP
+ EXCH A,GCSTOP
+ POPJ P,
+
+IFE ITS,[
+
+; THIS IS CRETINOUS, BUT WHAT DO YOU EXPECT FROM DEC SOFTWARE?
+
+XHALT: HALTF
+ JRST XHALT
+
+; DO TWENEX IOTING
+; IN (P) IS THE WORD WHICH ITS WOULD LIKE
+
+XIOTI: PUSH P,[SIN]
+ CAIA
+ PUSH P,[SOUT]
+XIOT: MOVE O,[A,,XACS]
+ BLT O,XACS+2
+ MOVE A,-1(P)
+ MOVE A,(A)
+ MOVE O,XACS-1(A)
+ MOVE A,DSKJFN
+ HRRZ B,O
+ TLO B,444400
+ HLRE C,O
+ PUSH P,C
+ XCT -1(P)
+ HRRZM B,BLKEND
+ AOS BLKEND ;FUCK THIS
+ CAME C,(P)
+ AOS -2(P)
+ MOVE O,[XACS,,A]
+ BLT O,C
+ SUB P,[2,,2]
+ JRST POPJ1
+
+XACS: BLOCK 3
+]
+
+\f
+;ROUTINE TO PARSE FILE NAMES (FROM SHARER)
+
+FPARSS: SETZM ENDSW
+FPARSE: SETZM NAME ;CLEAR NAME SLOT
+ SKIPE ENDSW
+ POPJ P,
+ MOVE F,[440600,,NAME]
+
+GETCHR: ILDB B,E ;FIND NEXT NON-EMPTY CHARACTER
+ CAIE B,0
+ CAIN B,3
+ JRST [SKIPN FJCLSW
+ POPJ P,
+ .CLOSE
+ SETZM FJCLSW
+ MOVE E,FJCLPT
+ JRST GETCHR]
+ CAIE B,40
+ CAIN B,^I
+ JRST GETCHR
+ CAIN B,"[
+ JRST [SETOM PRELOD
+ JRST GETCHR]
+ CAIN B,"(
+ JRST [PUSHJ P,ASKHAK
+ SETOM MANFLG
+ JRST GETCHR]
+ CAIN B,"{
+ JRST [PUSHJ P,FROBOZ
+ JRST GETCHR]
+ CAIN B,""
+ JRST [PUSHJ P,FILJCL
+ JRST GETCHR]
+
+FIELD: CAIN B,^J
+ POPJ P,
+ CAIE B,40 ;HERE TO GET A NAME
+ CAIN B,^I
+ JRST FNAM ;SPACE AND TAB MAKE FNAME1 AND 2
+ CAIE B,0
+ CAIN B,^M
+ JRST FNAM ;SO DOES 0 AND <CR>
+ CAIN B,""
+ JRST FNAM
+ CAIN B,",
+ JRST [SETOM ENDSW
+ JRST FNAM]
+ SKIPN COMSW
+ JRST [CAIE B,"_
+ JRST FIELD1
+ SETOM ENDSW
+ JRST FNAM]
+FIELD1: CAIN B,":
+ JRST DEV ;DEVICE NAME
+ CAIE B,"}
+ CAIN B,"]
+ JRST [SETOM ENDSW
+ SETOM ENDBRK'
+ JRST FNAM]
+ CAIN B,"/
+ JRST SWITCH
+ CAIN B,";
+ JRST FDIR ;SNAME
+ CAIN B,^Q ;HANDLE QUOTING
+ ILDB B,E
+ CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER)
+ JRST ILLCHR
+ SUBI B,40
+ CAIL B,100
+ SUBI B,40 ;CASE CONVERSION
+ TLNE F,770000 ;IGNORE MORE THAN 6 CHARACTERS
+ IDPB B,F
+FPARS2: ILDB B,E
+ JRST FIELD
+
+SWITCH: ILDB B,E
+ CAIN B,"T
+ SETOM TOTSW
+ CAIN B,"C
+ SETOM CHKSW
+ CAIN B,"M
+ SETOM MANFLG
+ CAIN B,"L
+ SETOM LSTFLG
+ JRST FPARS2
+
+DEV: MOVE A,NAME ;SAVE DEVICE
+ MOVEM A,DEVICE(D)
+ JRST FPARSE
+
+FDIR: MOVE A,NAME ;SAVE SNAME
+ MOVEM A,SNAME(D)
+ JRST FPARSE
+
+FNAM: MOVE A,NAME
+ JUMPE A,FPARSE
+ SKIPE FNAME1(D) ;DOES HE HAVE AN FNAME1 ALREAD?
+ JRST FNAM1 ;YES - OOPS. HE IS GIVING TWO NAMES
+ MOVEM A,FNAME1(D) ;NO - TRY IT AS FNAME1
+ JRST FPARSE
+
+FNAM1: MOVEM A,FNAME2(D) ;PUT NEW NAME INTO FNAME2
+ JRST FPARSE
+
+; HERE TO HACK GROSS FIND'AGE IN LIST OF FILES
+
+FROBOZ: SETOM SILENT
+ MOVE CMNMAX
+ ADDI 1
+ MOVEM CMNTOT'
+ MOVEM CMNSAV'
+FROBCN: SKIPE ENDBRK
+ JRST FROBBD
+ SKIPE JCLPTR
+ MOVE E,JCLPTR
+ SETZ D,
+ MOVE A,[SIXBIT />/]
+ MOVEM A,FNAME2
+ SETZM FNAME1
+ PUSHJ P,FPARSS
+ PUSH P,E
+IFN ITS,[
+ PUSHJ P,FPHACK
+]
+IFE ITS,[
+ OASC UNIMPL
+ HALT
+]
+ POP P,JCLPTR
+ SKIPN FNAME1
+ JRST FROBCN
+IFN ITS,[
+ .CALL DSKOPN
+ JRST FROBOF
+ .CALL RCHST
+ .LOSE 1000
+]
+ SETOM CHKSW
+ SETOM FROBSW'
+ JRST START2
+
+FSYNER: SUB P,[1,,1]
+ OASCR [0]
+ JRST FROBCN
+
+FROBOF: OASC [ASCIZ /Open of /]
+ PUSHJ P,PFNAME
+ OASCR [ASCIZ / failed./]
+ JRST FROBCN
+
+FROBBD: OASC [ASCIZ /Found /]
+ MOVE A,CMNTOT
+ SUB A,CMNSAV
+ ODEC A
+ OASC [ASCIZ / out of /]
+ ODEC CMNTOT
+ OASCR [ASCIZ /./]
+ HALT
+
+; HERE TO READ JCL FROM A FILE
+
+FILJCL: SKIPE STRSW
+ JRST FILTRM
+ SETOM STRSW
+ MOVE [SIXBIT />/]
+ MOVEM FNAME2
+ SETZM JCLPTR
+ PUSHJ P,FPARSS
+ CAIA
+FILTRM: SUB P,[1,,1] ; FLUSH THIS PUSHJ TO FPARSS
+ MOVEM E,FJCLPT'
+ SETZ D,
+IFN ITS,[
+ .CALL DSKOPN
+ JRST FILOPF
+]
+IFE ITS,[
+ OASC UNIMPL
+ HALT
+]
+ PUSHJ P,NXTJCL
+ MOVE E,[440700,,JCLINB]
+ SETOM FJCLSW'
+ POPJ P,
+
+FILOPF: OASC [ASCIZ /Open of /]
+ PUSHJ P,PFNAME
+ OASCR [ASCIZ / failed./]
+ HALT
+
+; HERE TO GET ATOMS FROM JCL TO BE LOOKED FOR
+
+ASKHAK: SETZM MCHRFL
+ SETZM MPADFL
+ CAIA
+ASKCLP: AOS CMNMAX
+ ILDB C,E
+ PUSHJ P,SEP
+ JRST ASKSEP
+ CAIE C,"{
+ CAIN C,")
+ JRST ASKSP1
+ CAIN C,""
+ JRST ASKSP1
+ SETOM MCHRFL
+ SETZM MPADFL
+ IDPB C,CMNPTR
+ JRST ASKCLP+1
+
+ASKSEP: SKIPN MCHRFL
+ JRST ASKCLP+1
+ SKIPE MPADFL
+ JRST ASKCLP+1
+ SETOM MPADFL
+ASKSP1: SETZ B,
+ IDPB B,CMNPTR
+ MOVEI B,ASKPAD
+ IDPB B,CMNPTR
+ CAIN C,")
+ POPJ P,
+ CAIE C,"{
+ CAIN C,""
+ CAIA
+ JRST ASKCLP
+ DBP E
+ POPJ P,
+
+\f
+IFN ITS,[
+;HACK >-1
+;MOST OF THIS CODE FROM ARCDEV (I.E. FROM ITS)
+
+FPHACK: MOVE X,FNAME2(D)
+ MOVE A,FNAME1(D)
+ SETZ B,
+ SETZ C,
+ CAMN X,[SIXBIT /NBIN/]
+ JRST NHAIR
+HAIR: TLNE X,770000 ;LEFT JUSTIFY
+ JRST HAIR1
+ LSH X,6
+ JRST HAIR
+HAIR1: LDB F,[301400,,X]
+ CAMN F,[SIXBIT / <+/]
+ JRST HAIR2
+ CAME F,[SIXBIT / >-/]
+ POPJ P, ;CAN'T HACK THIS
+ SETO C,
+ LSH X,6
+HAIR2: LSH X,6 ;GET RID OF CRUFT
+ LDB F,[360600,,X]
+ JUMPE F,HAIR3
+ CAIL F,'0 ;GET THE ARGUMENT
+ CAILE F,'9
+ JRST HAIR2
+ IMULI B,10
+ SUBI F,'0
+ ADD B,F
+ JRST HAIR2
+HAIR3: SKIPE C
+ TLO B,400000 ;SET BIT
+
+;4.9 BIT IN B IS SET FOR >
+;RH OF B IS ARGUMENT FOR THE SEARCH
+
+QLOOK: MOVE [-2000,,DIRPAG]
+ .CALL DIROPN
+ JRST OPNFL1
+ .CALL DIRIOT
+ JRST LOST0 ;REPORT INTERNAL BUG
+ .CLOSE DSKI,
+QLOOKR: MOVEI E,DIRPAG+2000-5
+ PUSH P,D
+ PUSH P,[-1] ;BEST INDEX
+ PUSH P,[SETZ] ;BEST "NUMERIC" PART
+ PUSH P,[SETZ] ;BEST ALPHA PART
+QLOOK4: CAIGE E,DIRPAG
+ JRST QLOOK2
+ CAME A,UFN1(E)
+ JRST QLOOK3
+ SKIPE X,UFN2(E)
+QLOOK6: TRNE X,77
+ JRST QLOOK5
+ LSH X,-6
+ JRST QLOOK6
+QLOOK5: MOVEI F,0
+QLOOK8: LDB D,[600,,X]
+ CAIL D,'0
+ CAILE D,'9
+ JRST QLOOK7 ;NOT A DIGIT
+QLOK5B: TRNE F,77 ;RIGHT ADJ LOW NON NUM PART
+ JRST QLOK5A
+ LSH F,-6
+ JUMPN F,QLOK5B
+QLOK5A: TLC X,400000 ;AVOID CAM LOSSAGE
+ TLC F,400000
+ SKIPGE -2(P)
+ JRST QLOK5D ;FIRST MATCH
+ JUMPGE B,QLOK5E ;GET LEAST
+ CAMGE X,-1(P) ;GET GREATEST
+ JRST QLOOK3
+ CAME X,-1(P)
+ JRST QLOK5D
+ CAMGE F,(P)
+ JRST QLOOK3 ;NOT AS GOOD
+QLOK5D: HRRZM E,-2(P)
+ MOVEM X,-1(P)
+ MOVEM F,(P)
+QLOOK3: SUBI E,LUNBLK
+ JRST QLOOK4
+
+
+QLOK5E: CAMLE X,-1(P)
+ JRST QLOOK3
+ CAME X,-1(P)
+ JRST QLOK5D
+ CAMLE F,(P)
+ JRST QLOOK3
+ JRST QLOK5D
+
+QLOOK7: LSHC X,-6 ;LOW DIGIT NOT NUMERIC
+ JUMPN X,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?)
+ JUMPL B,QLOK5B ;IF LOOKING FOR GREATEST, LET THIS BE LEAST
+ MOVNI X,1 ;GREATEST IF LOOKING FOR LEAST
+ JRST QLOK5B
+
+QLOOK2: SUB P,[1,,1]
+ POP P,C ;BEST "NUMERIC" PART
+ POP P,E ;ADR
+ JUMPL E,[POP P,D
+ POPJ P,]
+ HRRZ D,B
+ SOJL D,QFINIS ;KEEP GOING UNTIL REQUEST IS SATISFIED
+ POP P,D
+ SOJ B,
+ MOVE F,[SIXBIT /!!!!!!/]
+ MOVEM F,UFN1(E) ;MUNGE THE DIRECTORY
+ JRST QLOOKR ;START OVER
+
+QFINIS: POP P,D ;DONE!
+ MOVE B,UFN2(E)
+ MOVEM B,FNAME2(D)
+ POPJ P,
+
+;HERE TO HACK THE NBIN'AGE
+
+NHAIR: .CALL DIROPN
+ JRST OPNFL1
+ MOVE [-2000,,DIRPAG]
+ .CALL DIRIOT
+ JRST LOST0
+ PUSH P,D
+ SETZ C,
+ MOVEI E,DIRPAG+2000-5
+NBNFND: CAIGE E,DIRPAG
+ JRST NONBIN
+ MOVE X,UFN2(E)
+ CAMN A,UFN1(E)
+ CAME X,[SIXBIT /NBIN/]
+ JRST NBNNXT
+ MOVE B,UNDATE(E)
+ SETZ D,
+ .CALL DIROPN ; OPEN THE CORRECT DIRECTORY
+ JRST OPNFL1
+ MOVE [-2000,,DIRPAG]
+ .CALL DIRIOT
+ JRST LOST0
+ MOVEI E,DIRPAG+2000-5
+NLOOP: CAIGE E,DIRPAG
+ JRST NDONE
+ CAME A,UFN1(E)
+ JRST NLNXT
+ SKIPE X,UFN2(E)
+NLOOP1: TRNE X,77 ;RIGHT JUSTIFY NAME
+ JRST NLOOP2
+ LSH X,-6
+ JRST NLOOP1
+NLOOP2: LDB D,[600,,X] ;MAKE SURE NAME ENDS IN NUMERIC
+ CAIL D,'0
+ CAILE D,'9
+ JRST NLNXT
+NLOOP3: CAMLE B,UNDATE(E) ;COMPARE CREATION DATES
+ CAML C,UNDATE(E)
+ JRST NLNXT
+ MOVE C,UNDATE(E)
+ MOVE F,UFN2(E)
+ JRST NLNXT
+
+NDONE: JUMPL C,NBNLOS
+ POP P,D
+ MOVEM F,FNAME2(D)
+ MOVE F,SNAME
+ MOVEM F,SNAME(D)
+ POPJ P,
+
+NONBIN: OASC [ASCIZ /No NBIN file found./]
+ JRST OPNFL2
+
+NLNXT: SUBI E,LUNBLK
+ JRST NLOOP
+
+NBNNXT: SUBI E,LUNBLK
+ JRST NBNFND
+
+]
+
+NBNLOS: OASC [ASCIZ /No file created before NBIN./]
+ JRST OPNFL2
+
+\f
+;PRINT A FILE NAME. CHANNEL NUMBER IS IN D
+
+IFN ITS,[
+PFNAME: OSIX DEVICE(D)
+ OASCI ":
+ OSIX SNAME(D)
+ OASCI ";
+ OSIX FNAME1(D)
+ OASCI "
+ OSIX FNAME2(D)
+ POPJ P,
+]
+IFE ITS,[
+PFNAME: MOVE A,F1BLK(D)
+ MOVE B,(A)
+ OASC (B)
+ OASCI ":
+ OASCI "<
+ MOVE B,1(A)
+ OASC (B)
+ OASCI ">
+ MOVE B,2(A)
+ OASC (B)
+ OASCI ".
+ MOVE B,3(A)
+ OASC (B)
+ OASCI ".
+ MOVE B,4(A)
+ OASC (B)
+ POPJ P,
+]
+\f
+; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)
+
+ZZZ==.
+ LOC 40
+ 0
+ JSR UUOH
+ LOC ZZZ
+UUOCT==0
+UUOTAB: JRST ILUUO
+ IRPS X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS]
+ UUOCT==UUOCT+1
+ X=UUOCT_33
+ JRST U!X
+ TERMIN
+
+UUOMAX==.-UUOTAB
+
+UUOH: 0
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVEI @40 ; GET EFF ADDR. OF UUO
+ MOVEM UUOE'
+ MOVE @0
+ MOVEM UUOD' ; CONTENTS OF EFF ADR
+ MOVE B,UUOE ; EFF ADR
+ LDB A,[270400,,40] ; GET UUO AC,
+ LDB C,[330600,,40] ; OP CODE
+ CAIL C,UUOMAX
+ MOVEI C,0 ; GRT=>ILLEGAL
+ JRST @UUOTAB(C) ; GO TO PROPER ROUT
+
+UUORET: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A ; RESTORE AC'S
+ JRST 2,@UUOH
+
+IFN ITS,[
+ILUUO: .VALUE [ASCIZ /:\eILLEGAL UUO\e/]
+]
+IFE ITS,[
+ILUUO: HALT
+]
+UOBPTR: MOVEI C,0
+ MOVE B,UUOD
+ JRST UOASC1
+UOASCR: SKIPA C,[^M] ; CR FOR END OF TYPE
+UOASC: MOVEI C,0 ; NO CR
+ HRLI B,440700 ; MAKE ASCII POINTER
+UOASC1: ILDB A,B ; GET CHAR
+ JUMPE A,.+3 ; FINISH?
+ PUSHJ P,IOTA
+ JRST .-3 ; AND GET ANOTHER
+ SKIPN A,C ; GET SAVED CR?
+ JRST UUORET
+ PUSHJ P,IOTA
+ MOVEI A,^J
+ PUSHJ P,IOTA
+ JRST UUORET
+
+UOASCC: HRLI B,440700 ; MAKE ASCII POINTER
+UOAS1C: ILDB A,B ; GET CHAR
+ CAIN A,^C
+ JRST UUORET
+ PUSHJ P,IOTA
+ JRST UOAS1C ; AND GET ANOTHER
+
+UOCTLP: MOVEI A,^P
+ PUSHJ P,IOTA1
+
+UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE
+ PUSHJ P,IOTA
+ JRST UUORET
+
+UOSIX: MOVE B,UUOD
+USXOOP: JUMPE B,UUORET
+ LDB A,[360600,,B]
+ ADDI A,40
+ PUSHJ P,IOTA
+ LSH B,6
+ JRST USXOOP
+
+UOSIXS: MOVE A,[440600,,UUOD]
+USLOOP: ILDB C,A
+ ADDI C,40
+ PUSHJ P,IOTC
+ TLNE A,770000
+ JRST USLOOP
+ JRST UUORET
+
+UOHPOS: SUB B,HPOS
+ JUMPLE B,UOASCI
+UOHPO1: MOVEI A,40
+ PUSHJ P,IOTA
+ SOJG B,UOHPO1
+ JRST UUORET
+
+POWER: 0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000.
+
+UOALIG: MOVE D,UUOD
+ ANDI A,7
+ MOVE A,POWER(A)
+ MOVEI C,40
+UOALI1: CAMLE A,D
+ PUSHJ P,IOTC
+ IDIVI A,10.
+ CAIE A,1
+ JRST UOALI1
+ SETZ A,
+
+UODEC: SKIPA C,[10.] ; GET BASE FOR DECIMAL
+UOOCT: MOVEI C,8. ; OCTAL BASE
+ MOVE B,UUOD ; GET ACTUAL WORD TO PRT
+ JRST .+3 ; JOIN CODE
+UODECI: SKIPA C,[10.] ; DECIMAL
+UOOCTI: MOVEI C,8.
+ MOVEM C,BASE'
+ SKIPN A
+ HRREI A,-1 ; A=DIGIT COUNT
+ PUSHJ P,UONUM ; PRINT NUMBR
+ JRST UUORET
+
+UONUM: IDIV B,BASE
+ HRLM C,(P) ; SAVE DIGIT
+ SOJE A,UONUM1 ; DONE IF 0
+ SKIPG A ; + => MORE
+ SKIPE B ; - => B=0 => DONE
+ PUSHJ P,UONUM ; ELSE MORE
+UONUM1: HLRZ C,(P) ; RETREIVE DIGITS
+ ADDI C,"0 ; MAKE TO ASCII
+ CAILE C,"9 ; IS IT GOOD DIG
+ ADDI C,"A-"9-1 ; MAKE HEX DIGIT
+ PUSHJ P,IOTC
+ POPJ P, ; RET
+
+IOTC: PUSH P,A
+ MOVE A,C
+ PUSHJ P,IOTA
+ JRST POPAJ
+
+IOTA: CAIN A,^P
+ JRST IOTAP
+IOTA1:
+IFN ITS,[
+ CAIN A,^J
+ POPJ P,
+ .IOT TYOC,A
+]
+IFE ITS,[
+ PBOUT
+]
+ CAIN A,^I
+ JRST [MOVE A,HPOS
+ ADDI A,10
+ ANDI A,7770
+ MOVEM A,HPOS
+ POPJ P,]
+ AOS HPOS
+ CAIE A,^M
+ POPJ P,
+ SETZM HPOS
+ POPJ P,
+IOTAP:
+IFN ITS,[
+ .IOT TYOC,["^]
+ ADDI A,100
+ JRST IOTA1
+]
+IFE ITS,[
+ POPJ P,
+]
+
+POPAJ: POP P,A
+ POPJ P,
+
+IFN ITS,[
+COMBAT: SETOM COMSW
+ JUMPL A,COMTTO
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ 5000,,1
+ MOVEI TYOC
+ SETZ [SIXBIT /NUL/]]
+ JRST LOST0
+ JRST STARTX
+COMTTO: .CALL TTYOPN
+ .VALUE
+ .CALL [SETZ
+ SIXBIT /TTYGET/
+ MOVEI TYOC
+ MOVEM A
+ MOVEM B
+ SETZM C]
+ .LOSE 1000
+ TLO C,%TSMOR
+ .CALL [SETZ
+ SIXBIT /TTYSET/
+ MOVEI TYOC
+ A
+ B
+ SETZ C]
+ .LOSE 1000
+ .BREAK 16,100000
+ JRST STARTX
+]
+
+LOST0: MOVEI B,EINTER
+LOST: SKIPE COMSW
+ MOVE A,B
+ HALT
+
+
+; DISGUSTITUDE, R.E. MANIFESTS, ETC.
+
+INATOM: 0
+
+ATOM: SETZM WINNER
+ SETZM DEPTH
+ MOVEI ATOM1
+ MOVEM ACTIV
+ATOMSK: MOVE CH,[440700,,WRDBUF]
+ATOM1: NXTCHR C
+ SKIPE SKIPPR
+ JRST ATOM3
+ SETOM FUDGE ;TAA 5/31/78 OTHERWISE GOT DEPTH COUNT OFF
+ SKIPN DEPTH
+ PUSHJ P,GETSTT
+ATOM3: SKIPE QUOTSW
+ JRST AEXCLQ ;QUOTE SWITCH SET. CHECK FOR !"\\
+ CAIN C,"\
+ JRST AQUOTE ;QUOTE ONE CHARACTER
+ CAIN C,""
+ JRST ASTRIN ;TOGGLE STRSW AND CHECK FOR !"
+ CAIN C,"!
+ JRST AEXCL ;TOGGLE EXCLSW
+ SKIPE STRSW
+ JRST ATOM2 ;INSIDE STRING. IGNORE BRACKETS, ETC..
+ CAILE C,40
+ JRST ABRACK
+ CAIE C,40 ;SEP ROUTINE INCLUDED HERE FOR SPEED
+ CAIN C,TAB
+ JRST APAD
+ CAIE C,CR
+ CAIN C,LF
+ JRST APAD
+ CAIN C,FF
+ JRST APAD
+ABRACK: CAIE C,"< ;DO THE RIGHT THING WITH BRACKETS
+ CAIN C,"(
+ JRST APUSH
+ CAIE C,"[
+ CAIN C,"{
+ JRST APUSH
+ CAIE C,")
+ CAIN C,"}
+ JRST APOP
+ CAIE C,">
+ CAIN C,"]
+ JRST APOP
+ CAIN C,"'
+ JRST APAD
+ CAIN C,54
+ JRST NOATM
+ CAIE C,"#
+ CAIN C,".
+ JRST NOATM
+ATMCHR: SETOM INATOM
+ IDPB C,CH
+ATOM2: SETZM QUOTSW ;CLEAR RANDOM ONCE ONLY SWITCHES
+ SETZM EXCLSW
+ SETZM SPACSW
+ JRST ATOM1 ;NEXT
+
+NOATM: SKIPE INATOM
+ JRST ATMCHR
+ JRST ATOM2
+
+APUSH: AOS DEPTH
+ JRST APAD
+
+APOP: SOSLE DEPTH
+ JRST APAD
+ JRST POPJ1
+
+AEXCLQ: CAIN C,"\
+ SKIPN EXCLSW
+ JRST ATOM2
+ SETZM EXCLSW
+ JRST AQUOTE
+
+;COME HERE IF CHARACTER IS A SEPARATOR.
+
+APAD: SKIPE SPACSW ;HACK SEPARATORS CORRECTLY
+ JRST ATOM1
+ SETOM SPACSW
+ SKIPE INATOM
+ PUSHJ P,ATMHAK
+APAD1: SETZM INATOM
+ SETZM QUOTSW
+ SETZM EXCLSW
+ JRST ATOM1
+
+ATMHAK: PUSH P,A
+ SETZ B,
+ IDPB B,CH
+ MOVE B,[440700,,CMNBUF]
+ MOVE A,[440700,,WRDBUF]
+ MOVE CH,A
+ SKIPN WRDBUF
+ JRST POPAJ
+ MOVEI C,3
+ IDPB C,CMNPTR
+ PUSHJ P,ATMLKP
+ JRST POPDAJ
+ MOVE C,LSTTYP
+ CAILE C,1
+ JRST POPDAJ
+ MOVE A,OBJCNT
+ CAMN A,OBJSAV'
+ JRST POPDAJ
+ PUSH P,D
+ PUSHJ P,CHGOBJ
+ MOVEM A,OBJSAV
+ POP P,C
+ CAIN C,NMNPAD
+ MOVEI A,[ASCIZ / [New MANIFEST = /]
+ CAIN C,MACPAD
+ MOVEI A,[ASCIZ / [Changed MACRO = /]
+ CAIN C,CMNPAD
+ MOVEI A,[ASCIZ / [Changed MANIFEST = /]
+ CAIN C,ASKPAD
+ MOVEI A,[ASCIZ / [Requested ATOM = /]
+ OASC (A)
+ OASC WRDBUF
+ OASCR [ASCIZ /]/]
+ JRST POPDAJ
+
+POPDAJ: DBP CMNPTR
+ JRST POPAJ
+
+; LOOKUP ROUTINE FOR CHANGED MANIFESTS/MACROS
+; SIMILAR TO ENTLKP EXCEPT FOR PAD CODES
+
+ATMLKP: PUSH P,A
+ ILDB C,A
+ JUMPE C,POPAJ
+ATMLP: ILDB D,B
+ CAIN D,3
+ JRST POPAJ
+ SKIPA A,(P)
+ATMLP1: ILDB D,B
+ ILDB C,A
+ CAME C,D
+ JRST ATMLP2
+ JUMPN C,ATMLP1
+ ILDB D,B
+POPAJ1: POP P,A
+POPJ1: AOS (P)
+CPOPJ: POPJ P,
+
+ATMLP2: ILDB C,B
+ CAIN C,3
+ JRST POPAJ
+ JUMPN C,ATMLP2
+ ILDB C,B
+ JRST ATMLP
+
+WRDBUF: BLOCK 10.
+
+;HANDLE EXCL
+
+AEXCL: SKIPE STRSW
+ JRST ATOM2
+ SETOM EXCLSW
+ JRST ATOM1
+
+;HANDLE STRINGAGE
+
+ASTRIN: SKIPE EXCLSW
+ JRST AQUOTE ;MUST BE !"X
+ SETCMM STRSW ;ELSE TOGGLE STRING MODE
+ JRST ATOM2 ;NO. CONTINUE
+
+;QUOTE A CHARACTER
+
+AQUOTE: SETOM QUOTSW
+ JRST ATOM1
+
+ END START
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff