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==</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 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 ;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 ;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, ;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 ;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 ;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 ;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, ;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, ;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, ;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 ;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 ;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 ;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 ;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 ;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 ;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, ;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 ] ;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 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, 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 ;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, ] ; 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 /:ILLEGAL UUO/] ] 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