TITLE FIND -- directory search program PDL (3/12/76) .MLLIT=1 ; ================================================================ ; ac definitions ; ================================================================ A=1 B=2 C=3 D=4 E=5 F=6 G=7 TP=7 ; pointer to searching data buffer UP=10 ; pdl pointer to three-word device blocks FP=11 ; pdl pointer to search blocks DP=12 ; pdl pointer to two-word directory blocks PP=13 ; pdl pointer to parsing stack H=10 I=11 J=12 K=13 L=14 ; only for super-temp uses under these names M=15 ; only for super-temp uses ALT=14 ; copy from DIR, use to hack world, then copy back DIR=16 ; aobjn pointer to dir vector P=17 ; PDL pointer ; ================================================================ ; channels ; ================================================================ TYIC==1 ; tty input TYOC==2 ; tty output IC==3 ERR==4 DSKBI==5 MFDBI==6 ; ================================================================ ; flags ; ================================================================ %MATCH==400000 ; means not a match %FOUND==200000 ; means already looked at %NATCH==100000 ; saved matches from previous try ; ================================================================ ; its file system definitions ; ================================================================ .INSRT SYSTEM;FSDEFS > ; ================================================================ ; variables ; ================================================================ PDL: BLOCK 101. ; PDL UPDL: BLOCK 52. TPDL: BLOCK 201 FPDL: BLOCK 51. DPDL: BLOCK 1001. LNKBUF: BLOCK 3 ; link file cons'ed up here BUFFER: BLOCK 2000 ; printing buffer for :COMB DIRBUF: BLOCK 2000 ; directory lives here DIRVCT: BLOCK 200. ; directory vector lives here MFDBUF: BLOCK 2000. MFDVCT: BLOCK 500. MFDSAV: 0 ; cptr to mfd entries COMMND: BLOCK 400 COMPTR: 0 ERROPN: SIXBIT / ERR/ ? 4 ? 0 STAR: SIXBIT /* * / DATNOW: 0 ; current date in disk format DIRTMP: SIXBIT /DSK .FILE.(DIR) SYSTEM/ FILE: DEV: SIXBIT /DSK/ NM1: SIXBIT /_EDIT_/ NM2: SIXBIT />/ SNM: 0 ; sname default ; ddt file default PDISK: 0 PFILE: 0 ; dev 0 ; snm 0 ; nm1 0 ; nm2 ; :COMB file default (for hysterical reasons) COMDEF: SIXBIT /DSK/ SIXBIT /PLAN/ 0 'COMBAT FONE: SIXBIT /DSK _EDIT_> / ? 0 MONE: BLOCK 3 FTWO: BLOCK 4 MTWO: BLOCK 2 TTWO: BLOCK 4 OUTFIL: SIXBIT /TTY FIND OUTPUTFOOBAR/ OUTMOD: 21 OUTOPN: SETZ SIXBIT /OPEN/ MOVS OUTMOD MOVEI TYOC OUTFIL OUTFIL+1 OUTFIL+2 OUTFIL+3 SETZB LSTERR MSNAME: 0 NODEFL: 0 ; -1 if shouldn't set filename default MORLOK: 0 ; set in PREXIT to inhibit more interrupt LCLITS: 0 ; pointer to table slot for local its DISK: 0 ; do it first if its asked for ITSPDL: BLOCK 10 ; room for expansion.... ITSPTR: -<.-ITSPDL>,,ITSPDL-1 ; aobjn to its's ITSSAV: -,,ITSPDL ; call block for .call /sstatu/ RDSYST: SETZ 'SSTATU 2000,,0 2000,,0 2000,,0 2000,,0 2000,,0 SETZM LCLITS QPTR: 0 TRESRV: BLOCK 20 TPKID: BLOCK 20 ; ================================================================ ; start up ; ================================================================ START: SETOM SYLCNT' MOVEI A,DIRBUF MOVEM A,THEDIR' ; origin of directory buffer MOVE P,[-100.,,PDL+1] ; set up pdls MOVE TP,[TPDL-1] MOVE FP,[FPDL-1] MOVE DP,[DPDL-1] MOVE UP,[UPDL-1] ; general useful info collection time... .CALL RDSYST ; what ITS are we on? JFCL .CALL [SETZ ? 'RQDATE ? SETZM DATNOW ] JFCL ; who cares? HLLZS DATNOW ; truncate to date .SUSET [.RSNAM,,MSNAME] ; on start .SNAM==MSNAM ; open ttys and set up tty interrupt .OPEN TYIC,[SIXBIT / TTYFIND INPUT /] .VALUE [ASCIZ /:CAN'T OPEN TTY/] .CALL OUTOPN .VALUE [ASCIZ /:CAN'T OPEN TTY/] ; set up TTY interrupt .CALL [SETZ 'TTYGET 1000,,TYIC 2000,,A 402000,,B] .VALUE [ASCIZ /:CANT GET CONSOLE TYPE/] ; make only ^G and ^S interrupt MOVE 0,[SIXBIT / !!!!!/] ANDCAM 0,A MOVE 0,[SIXBIT / !!!!!/] ANDCAM 0,B .CALL [SETZ 'TTYSET 1000,,TYIC A 400000,,B] .VALUE [ASCIZ /:CANT SET CONSOLE TYPE/] ; enable cretinous moreage .CALL [SETZ 'TTYGET MOVEI TYOC MOVEM A MOVEM B MOVEM C SETZB LSTERR'] .VALUE [ASCIZ /:CANT GET CONSOLE TYPE/] TLZ C,%TSMOR .CALL [SETZ 'TTYSET MOVEI TYOC A B C SETZB LSTERR] .VALUE [ASCIZ /:CANT SET CONSOLE TYPE/] .SUSET [.SMASK,,[1]] .SUSET [.SMSK2,,[<1_TYIC>#<1_TYOC>]] ; ================================================================ ; read a command line or two ; ================================================================ ; get command line from superior SETOM LEFTAR' SETZM LISTF' .SUSET [.ROPTIO,,A] ; get superiors option word MOVEM A,OPTION' ; TLNN A,OPTBRK ; OPTBRK can it handle all .BREAK? ; JRST JCLARG ; if can handle all breaks, then maybe we should be a :LISTF? .SUSET [.RXJNAM,,B] CAMN B,[SIXBIT /FDIR/] ;>> SETOM BRIEFP CAMN B,[SIXBIT /COMPAR/] SETOM CMPFLG' CAME B,[SIXBIT /LISTF/] CAMN B,[SIXBIT /LF/] SETOM LISTF CAMN B,[SIXBIT /LIST/] SETOM LISTF CAME B,[SIXBIT /COMB/] JRST .+3 SETOM CMBFLG' SETOM FLPRT SKIPE LISTF .BREAK 12,[..RPFILE,,PFILE] ; read DDT print defaults ; has jcl for us? JCLARG: TLNN A,OPTCMD ; OPTCMD has JCL? JRST TTYARG .BREAK 12,[..RJCL,,COMMND] SKIPE COMMND ; none there? JRST CMDIN ; no arg, must get one from tty unless we are :LISTF TTYARG: SKIPE CMPFLG JRST COMRMF ; if :COMPAR, no JCL, then compare MFD SKIPE LISTF JRST SETLF SKIPE CMBFLG JRST SETCOM OASC [ASCIZ /FIND./] OSIX [.FNAM2] OASCR [0] ; here to get and process a line from tty QQLOOP: OASC [ASCIZ /FIND=/] PUSHJ P,READ ; read a command line JRST CRLOOP CMDIN: MOVE A,COMMND SKIPN CMPFLG JRST CRLOOP CAMN A,[ASCIZ /*î/] JRST COMRMF ; here to process command line CRLOOP: MOVE A,[440700,,COMMND] MOVEM A,COMPTR SKIPE LEFTAR PUSHJ P,FILOUT ; try to find script file spec SKIPN CMPFLG JRST CRLOO1 MOVE A,[DIRTMP,,CMPONE] MOVE B,A BLT A,3(B) MOVEI D,CMPONE PUSHJ P,SCNAME MOVE A,[DIRTMP,,CMPTWO] BLT A,3(B) MOVEI D,CMPTWO PUSHJ P,SCNAME CRLOO1: PUSHJ P,PARSE ; parser itself JRST QQLOOP ; fails to skip if wants more ; here for final cleanup and fall through to actual search ; set up default if necessary and return PAREND: PUSHJ P,PUSHIT ; if accumulating a file, put it out ; fix up default device CAIE UP,UPDL-1 JRST PARST1 SKIPN CMBFLG ; only default this way if not funny jname SKIPE LISTF SKIPA PUSHJ P,PSHDSK SETZ B, SKIPE CMBFLG MOVE B,COMDEF SKIPE LISTF MOVE B,PFILE ; default device JUMPE B,PARST1 PUSHJ P,DEVICE PARST1: SKIPN LISTF ; default sname for :LISTF JRST PARCOM MOVE B,PFILE+1 JRST PARST3 PARCOM: SKIPN CMBFLG ; default sname for :COMB JRST PARDEF MOVE B,COMDEF+3 PARST3: SETO E, CAIN DP,DPDL-1 PUSHJ P,PSHSNM ; do right thing if no file has been given PARDEF: CAIE FP,FPDL-1 JRST PARSET ; put out default of search all dsk MOVE A,[SKIPA] SKIPE CMBFLG MOVE A,[PUSHJ P,COMCHK] PUSH TP,A PUSH FP,TP PUSH TP,[SWOR] ; this is an OR operation ; local its is default if no host given PARSET: MOVE B,ITSPTR SKIPE (B) JRST PARST2 AOBJN B,.-2 MOVSI B,'DSK MOVEM B,ITSPDL ; fix up right halves of pdl pointers PARST2: HRRI DP,DPDL ; list of directories HLRZ DP MOVNS HRL DP, HRRI FP,FPDL ; list of searches HLRZ FP MOVNS HRL FP, HRRI UP,UPDL ; list of devices HLRZ UP MOVNS HRL UP, ; fix up to make an aobjn ptr JRST FIND ; set up fake default JCL for LISTF of no arguments SETCOM: MOVE B,COMDEF PUSHJ P,DEVICE MOVE B,COMDEF+3 SETO E, PUSHJ P,PSHSNM JRST PARDEF SETLF: MOVE B,PFILE PUSHJ P,DEVICE MOVE B,PFILE+1 SETO E, PUSHJ P,PSHSNM JRST PARDEF ; jump back and hack its default ; ================================================================ ; read in and search directories ; ================================================================ FIND: .CALL OUTOPN .VALUE [ASCIZ /:CANT OPEN OUTPUT FILE/] SETZB F,FILES ; number of files found SETZM LINKS ; number links found SETZM BLOCKS ; number blocks found MOVE ITSSAV MOVEM ITSPTR MOVEM DP,DPSAVE' ; DP now is used for "found" dirs MOVEM FP,FPSAVE' MOVEM UP,UPSAVE' ; here move file compares to front MOVE E,FPSAVE FPSLU1: MOVEI D,0 MOVE FP,E FPSORT: MOVE A,(FP) SKIPN B,1(FP) JRST FPSEND MOVE C,1(B) CAMN C,[SWSAVE] JRST FPSEND MOVE C,(B) CAME C,[PUSHJ P,MSTAR] JRST FPSLUP MOVE C,(A) CAMN C,[PUSHJ P,MSTAR] JRST FPSLUP MOVEI D,1 MOVEM B,(FP) MOVEM A,1(FP) JRST FPSORT FPSLUP: AOBJN FP,FPSORT JUMPN D,FPSLU1 FPSEND: ADD FP,[2,,2] MOVE E,FP JUMPL FP,FPSLU1 ; maybe we are actually a compare? SKIPE CMPFLG JRST COMPAR ; here for an mfd or so SKIPN A,LCLITS ; find the local MFD if it is JRST NXTMFD ; in the list and do it MOVE B,ITSPTR CAMN A,(B) JRST NEWMF1 AOBJN B,.-2 NXTMFD: MOVE B,ITSPTR ; find the next MFD we haven't done NXTMF1: SKIPE (B) JRST NEWMF1 AOBJN B,NXTMF1 JRST SUMMAR ; go print summary NEWMF1: MOVE A,(B) SETZM (B) ; zero it PUSHJ P,GETMFD ; returns DP/ aobjn to dirs JRST NXTMFD ; no MFD there! JUMPGE DP,NXTMFD ; should have some matches ; cretinous job devices log out and clog cretinous system console, ; so make cretinous thing happy by not overdoing remote searches. CAME A,LCLITS CAMN A,[SIXBIT /DSK/] JRST FINDLP ; win on local ITS HLRE A,DP ; how many on foreign host? CAML A,[-4] ; enough for SYS*; on other ITS JRST FINDLP OASCR [0] OSIX DISK OASCR [ASCIZ /: == ANTI-SOCIALLY LARGE SEARCH NOT PERFORMED ==/] JRST NXTMFD ; now perform search using MFD we got FINDLP: MOVE B,(UP) CAMN B,[SIXBIT /DSK/] MOVE B,DISK ; normal case MOVEM B,FONE MOVE C,1(UP) MOVEM C,FONE+1 MOVE C,2(UP) MOVEM C,FONE+2 MOVE C,(DP) MOVEM C,FONE+3 MOVE C,3(UP) ; instruction, JFCL except for archives ; search directory specified in FONE MOVEI A,FONE PUSHJ P,SEARCH ; fone set up get dir JRST FINEX0 JRST FINEX1 ; here print matches found in this directory SETZ E, ; loop through directory looking for files marked as matches FINPRT: MOVE A,(ALT) TLNN A,%MATCH+%NATCH JRST FINPNX ; this one isn't a match ; first print device and sname found in SKIPN FLPRT ; always print header if :COMB JRST GOTON1 OCTLP "C ; and clear screen too JRST GOTON2 GOTON1: SKIPE TECFLG JRST GOTON3 JUMPN E,PRTFIL ; print its:snm;arc: if haven't yet GOTON2: SKIPE NOLIST JRST PRTFIL ; oh well, just totaling matches SKIPN E,OLDISK' ; previous disk? JRST .+3 CAME E,DISK OASCR [0] GOTON3: PUSH P,ALT MOVE E,DISK MOVEM E,OLDISK SKIPE TECFLG JRST .+3 CAMN E,[SIXBIT /DSK/] MOVE E,LCLITS OSIX E OASCI ": SKIPE TECFLG OASCI 11 OSIX FONE+3 OASC [ASCIZ /;/] SKIPE TECFLG OASCI 11 MOVE E,1(UP) CAMN E,[SIXBIT /.FILE./] JRST GOTFNY ; check if funny OSIX 1(UP) JRST DOCOLN GOTFNY: MOVE E,(UP) ; here for funny directory CAMN E,[SIXBIT /DSK/] JRST JSTDSK OSIX (UP) ; print funny disk-like device DOCOLN: OASCI ": SKIPE TECFLG OASCI 11 JSTDSK: SKIPN TECFLG OASCR [0] SETO E, POP P,ALT ; fall through for file names ; print files found PRTFIL: MOVE A,1(UP) ; funny device? CAMN A,[SIXBIT /.FILE./] MOVE A,(UP) ; if not, use real one MOVEM A,PFILE ; default device MOVE A,FONE+3 MOVEM A,PFILE+1 ; default sname ADDI F,1 ; count of files found MOVE A,(ALT) MOVE (A) MOVEM PFILE+2 ; default nm1 MOVE 1(A) MOVEM PFILE+3 ; default nm2 MOVE DISK MOVEM PDISK SKIPE TECFLG JRST FINPN1 PUSHJ P,LFPRNT ; print file JRST FINPNX FINPN1: OSIX UNFN1(A) OASCI 11 OSIX UNFN2(A) OASCR [0] ; here to move to next file FINPNX: PUSHJ P,ANEXT JRST FINPRT ; loop ; after printing files, move to next device in directory FINEX1: Skipe BriefP ;>> Jrst [OAscr [0] Setzm BCount Jrst .+1] ADDI UP,3 ; move to next device AOBJN UP,FINDLP ; after devices exhausted move to next directory MOVE UP,UPSAVE' ; move to next directory AOBJN DP,FINDLP JRST NXTMFD ; here after dir open fails FINEX0: MOVE 1(UP) CAIN [SIXBIT /.FILE./] JRST FINWHY CAIE A,%ETMLK ; link depth exceeded CAIN A,%EBDLK ; link to non-existent file JRST FINWAR ; print that archive was a loser CAIE A,%ENAFL ; file locked CAIN A,%ENAPK ; pack not mounted JRST FINWAR CAIN A,%ENSFL ; no such file -- archive types are done via opening JRST FINEX1 ; the appropriate its file FINWHY: CAIE A,%ENSDR ; no such directory? CAIN A,%ENSDV ; no such device? JRST FINEX1 ; print reason for open of directory failing if not one of the "reasonable" reasons. MOVEM A,ERROPN+2 OASCR [0] OSIX DISK OASCI ": OSIX (DP) OASC [ASCIZ /; == CAN'T READ DIR == /] PUSHJ P,EXPLAI OASCR [ASCIZ / ==/] JRST NXTMFD ; print why archive lost FINWAR: MOVEM A,ERROPN+2 OASCR [0] OSIX DISK OASCI ": OSIX (DP) OASCI "; OSIX 1(UP) OASC [ASCIZ /: == NOT READABLE == /] PUSHJ P,EXPLAI OASCR [ASCIZ / ==/] JRST FINEX1 ; after directories exhausted, print total of files found and quit SUMINT: OASCR [0] ; come here after interrupt SUMMAR: SKIPN TOTFLG ; come here on normal exit JRST EXIT OASC [ASCIZ /(Found /] ; done, print total found ODEC FILES' OASC [ASCIZ / files, /] ODEC BLOCKS' OASC [ASCIZ / blocks, /] ODEC LINKS' OASC [ASCIZ / links)/] ; here for tasteful exit EXIT: MOVE A,OPTION TLNN A,OPTBRK JRST DEATH ; none of this works if not OPTBRK MOVE A,PDISK ; 10/3/80 PDL Sigh, maybe this fixes MOVEM A,PFILE ; the DSK: bug? SKIPE PFILE+1 ; only set print defaults if we have SKIPE NODEFL ; found at least one file and user SKIPA ; didn't disable it .BREAK 12,[..SPFILE,,PFILE] DEATH: .LOGOUT ; disowning is fun too .BREAK 16,160000 ; quit -- if can't do .break, tough JRST .-1 ; should never happen... ; for single directory, loop through searches defined by user ; A/ ptr to open block ; C/ inst. to execute SEARCH: MOVE FP,FPSAVE ; restore search spec PUSHJ P,GETDIR ; read a u.f.d. POPJ P, ; not there? JRST SEARCX ; not really an archive, tho looked like one... PUSHJ P,PRSDIR ; set up aobjn to it MOVE DIR,ALT JUMPGE DIR,SEARCX ; nothing in directory? ; set up matching SEARL1: HRRZ TP,(FP) ; pick up test block pointer PUSHJ P,MARK ; mark matches AOBJN FP,SEARL1 ; continue for each test AOS (P) SEARCX: AOS (P) POPJ P, ; ================================================================ ; print short info blurb ; ================================================================ CINFO: ASCIZ % :FIND output_dir;... dev:... file... switch output -- put file names found here instead of TTY:. dir -- any number of directory names, each followed by ;. default is all directories. * in dir matches any char. dev -- any number of disk-like devices, each followed by :. default is DSK:. AR*: is any archive. *: is DSK:AR*:. file -- any number of file specs separated by space or comma. * in a file name matches any character. switch -- any number of legal switches, preceded by / (OR), & (AND), /NOT (NOR), &NOT (NAND). Some switches are: LINK, DUMPED, CDATE, RDATE, TO (Linked to), REAP, SIZE. Typing ^S or ^G at any time kills FIND. :FIND ; and :FIND ; are similar to :LISTF ;. See .INFO.;FIND INFO for more details. % INFO: OASCR CINFO JRST EXIT ; ================================================================ ; read a command line ; ================================================================ ; set up buffer READ: PUSH P,A PUSH P,B SETZM COMMND MOVE [COMMND,,COMMND+1] BLT 0,COMMND+17 ; command reader RCMD: MOVE B,[440700,,COMMND] MOVEM B,COMPTR MOVEI C,0 RCMD1: .IOT TYIC,A CAIN A,177 JRST RUB CAIN A,^D JRST RREPEA CAIN A,^L JRST RCLEAR CAIN A,^J JRST RCMD1 CAIN A,^Q JRST RQUOTE CAIN A,^M JRST RCMDX RCMDL: IDPB A,B CAMGE B,[350700,,COMMND+17] AOJA C,RCMD1 RCFUL: IDPB A,B MOVEI A,15 IDPB A,B RCMDX: IDPB A,B MOVEI A,0 IDPB A,B POP P,B POP P,A POPJ P, RREPEA: OASCR [0] JRST REPPER RCLEAR: OCTLP "C REPPER: OASC [ASCIZ /FIND=/] OASC COMMND JRST RCMD1 RQUOTE: IDPB A,B CAML B,[350700,,COMMND+17] JRST RCFUL SETOM QUTFLG ADDI C,1 .IOT TYIC,A SETZM QUTFLG' JRST RCMDL RUB: PUSHJ P,RUBBER JRST RCMD JRST RCMD1 RUBBER: SOJL C,[POPJ P,] ; erasure rubout handler MOVEI A,0 DPB A,B OCTLP "X ADD B,[070000,,] TLNE B,400000 ADD B,[347777,,-1] AOS (P) POPJ P, ; ================================================================ ; parse a command line ; ================================================================ PARSE: PUSHJ P,FINIT ; initialize file stuff ; read and dispatch on a syllable and its terminator PARLUP: PUSHJ P,GETSYL ; A/ terminator JUMPN B,PARFIL ; B/ syllable JUMPE A,PARLUP ; if syl and term both 0, loop JUMPL A,PAREND PARFIL: JUMPLE A,FILBEG ; if space, hack it CAIN A,', JRST FILEND PUSHJ P,PUSHIT ; else clean up mess ; dispatch on terminators CAIN A,'; JRST FILSNM ; ; a directory pattern CAIE A,'& CAIN A,'/ JRST READSW ; / -- this is a kludge CAIN A,': JRST FILDEV ; : a device pattern CAIN A,'+ JRST PAREND ; .... + signal for more commands JUMPG A,SYNERR CAIE A,'+ AOS (P) POPJ P, ; ================================================================ ; individual command handlers ; ================================================================ ; FIND TPL_ -- scripting device FILOUT: SETZM FONE SETZM FONE+1 SETZM FONE+2 SETZM FONE+3 PUSH P,COMPTR MOVEI D,FONE PUSHJ P,SCNAME SETZM SLASH SETZM AMPERS SETZM LEFTAR CAIE A,'_ JRST FILNOT ; no scripting SKIPN FONE SKIPE FONE+1 JRST FILWIN SKIPN FONE+2 SKIPE FONE+3 JRST FILWIN FILNOT: POP P,COMPTR SETOM SYLCNT POPJ P, FILWIN: MOVEI A,1 MOVEM A,OUTMOD SKIPN A,FONE MOVSI A,(SIXBIT /DSK/) MOVEM A,OUTFIL SKIPN A,FONE+1 MOVE A,[SIXBIT /FIND /] MOVEM A,OUTFIL+1 SKIPN A,FONE+2 MOVE A,[SIXBIT /OUTPUT/] MOVEM A,OUTFIL+2 SKIPN A,FONE+3 MOVE A,MSNAME MOVEM A,OUTFIL+3 POP P,0 POPJ P, ; FIND AR*: ; FIND *: ; FIND DSK:AR2: -- device search specifications ; macro defining command table DEFINE DSP DIS,NMS IRP NM,,[NMS] SIXBIT /!NM!/ DIS TERMIN TERMIN DEVTBL: DSP ALLTPL,[TPL] DSP ALLCOM,[COM] DSP ALLSYS,[SYS] DSP ALLDSK,[DSK] DSP ALLARC,[AR*] DSP ALLDEV,[*] DSP ALLNET,[**] DSP ALLAI,[AI] DSP ALLML,[ML] DSP ALLDM,[DM] DSP ALLMC,[MC] DEVPTR: -<<.-DEVTBL>/2>,,DEVTBL FILDEV: PUSHJ P,DEVICE JRST PARSE DEVICE: MOVE A,DEVPTR FILDLP: CAMN B,(A) JRST @1(A) ADDI A,1 AOBJN A,FILDLP ; here for funny AR* pattern MOVE A,B AND A,[777700,,0] CAMN A,[SIXBIT /AR/] JRST ONEARC ; here for packs given as devices CAMN A,[SIXBIT /PK/] JRST PKN AND A,[770000,,0] CAMN A,[SIXBIT /P/] JRST PNN ; here for funny SECOND: THIRD:, etc. junk. SKIPN QPTR PUSHJ P,GETRSR MOVE A,QPTR CAMN B,(A) JRST SECWIN AOBJN A,.-2 ; here for give up, never heard of this device BADDEV: OASC [ASCIZ /Never heard of device "/] OSIX B OASCR [ASCIZ /:"? Ignoring it./] POPJ P, PKN: MOVE A,B LSH A,12. JRST PCKNUM PNN: MOVE A,B LSH A,6 PCKNUM: MOVEI C,0 PCKNLP: MOVEI 0,0 LSHC 0,6 JUMPE 0,PCKNND CAIL 0,'0 CAILE 0,'9 JRST BADDEV ANDI 0,17 IMULI C,10. ADD C,0 JRST PCKNLP PCKNND: MOVE B,C JRST SECWI1 ; here we have a funny secondary device SECWIN: SUBI A,TRESRV MOVE B,TPKID(A) SECWI1: MOVE A,SWDEV ;SWAND or SWNAND MOVEM A,SWTYPE JRST SPACK ;will popj DSKDEV: PUSHJ P,GETSYL CAIE A,': JUMPG A,SYNERR PUSHJ P,PSHDSK POPJ P, ARCDEV: PUSHJ P,GETSYL CAIE A,': JUMPG A,SYNERR PUSHJ P,PSHARC POPJ P, DSKDIR: SIXBIT /DSK/ SIXBIT /.FILE./ SIXBIT /(DIR)/ SKIPA ARCDIR: SIXBIT /DSK/ SIXBIT /ARC/ SIXBIT />/ PUSHJ P,ARCFIX ; skip return if this is a new device not already stacked DEVDUP: PUSH P,B HLRE B,UP MOVNS B HRLS B HRRI B,UPDL JUMPGE B,DEVNEW DEVDUL: MOVE (A) CAME (B) JRST DEVNXT MOVE 1(A) CAME 1(B) JRST DEVNXT MOVE 2(A) CAME 2(B) JRST DEVNXT MOVE 3(A) CAMN 3(B) JRST DEVOLD DEVNXT: ADDI B,3 AOBJN B,DEVDUL DEVNEW: AOS -1(P) DEVOLD: POP P,B POPJ P, ; here to push a dsk device data block PSHDSK: MOVEI A,DSKDIR PUSHJ P,DEVDUP POPJ P, PUSH UP,DSKDIR ; this is ignored now? PUSH UP,DSKDIR+1 PUSH UP,DSKDIR+2 PUSH UP,DSKDIR+3 SUB UP,[3,,0] POPJ P, ; here to push an archive device data block (archives must be fixed up) PSHARC: MOVEM B,ARCDIR+1 MOVEI A,ARCDIR PUSHJ P,DEVDUP POPJ P, PUSH UP,ARCDIR PUSH UP,ARCDIR+1 PUSH UP,ARCDIR+2 PUSH UP,ARCDIR+3 SUB UP,[3,,0] POPJ P, ONEARC: PUSHJ P,PSHARC ; push a single archive spec POPJ P, ALLTPL: MOVE B,[SIXBIT /.LPTR./] JRST ALLSNM ALLCOM: MOVE B,[SIXBIT /COMMON/] JRST ALLSNM ALLSYS: MOVE B,[SIXBIT /SYS/] ; SYS: --> SYS; and SYS1; and SYS2; PUSHJ P,PSHSNM MOVE B,[SIXBIT /SYS1/] PUSHJ P,PSHSNM MOVE B,[SIXBIT /SYS2/] PUSHJ P,PSHSNM MOVE B,[SIXBIT /SYS3/] ALLSNM: PUSHJ P,PSHSNM POPJ P, PSHITS: PUSH P,B MOVE B,ITSSAV CAMN A,(B) JRST PSHITX AOBJN B,.-2 SKIPL B,ITSPTR JRST PSHITX PUSH B,A MOVEM B,ITSPTR PSHITX: POP P,B POPJ P, ALLNET: MOVSI A,(SIXBIT /AI/) PUSHJ P,PSHITS MOVSI A,(SIXBIT /ML/) PUSHJ P,PSHITS MOVSI A,(SIXBIT /DM/) PUSHJ P,PSHITS MOVSI A,(SIXBIT /MC/) PUSHJ P,PSHITS POPJ P, ALLAI: MOVSI A,(SIXBIT /AI/) ONEITS: PUSHJ P,PSHITS POPJ P, ALLDM: MOVSI A,(SIXBIT /DM/) JRST ONEITS ALLML: MOVSI A,(SIXBIT /ML/) JRST ONEITS ALLMC: MOVSI A,(SIXBIT /MC/) JRST ONEITS ALLDSK: PUSHJ P,PSHDSK ; push a dsk spec POPJ P, ALLDEV: PUSHJ P,PSHDSK ; push a dsk spec and all archive specs ALLARC: MOVSI B,(SIXBIT /ARC/) ; push all archive specs PUSHJ P,PSHARC MOVSI B,(SIXBIT /AR0/) ALLLUP: PUSHJ P,PSHARC ADD B,[1,,0] CAMG B,[SIXBIT /AR9 /] JRST ALLLUP POPJ P, ; here to push one name of a file spec ; B/ file name ; E/ mask for file name search FILBEG: JUMPE A,FILSTO CAMN B,[SIXBIT /?/] SKIPE SYLCNT ; initialized to -1 JRST FILSTO JRST INFO FILSTO: MOVEM B,(C) MOVEM E,3(C) AOBJN C,PARLUP ; finish a file spec we have been accumulating FILEND: MOVEM B,(C) MOVEM E,3(C) PUSHJ P,PUSHER JRST PARLUP ; pushes a file spec search block if it needs pushing PUSHIT: CAMN C,[-2,,FONE+1] POPJ P, ; pushes a file spec search block PUSHER: PUSH TP,[PUSHJ P,MSTAR] PUSH FP,TP PUSH TP,[SWOR] PUSH TP,FONE+1 PUSH TP,MONE PUSH TP,FONE+2 PUSH TP,MONE+1 FINIT: MOVE C,STAR MOVEM C,FONE+1 ; initialize fnms to "*" MOVEM C,FONE+2 MOVE C,[-2,,FONE+1] ; initialize fnm pointer SETZM MONE ; which matches anything SETZM MONE+1 POPJ P, ; FIND FOO; -- pushes an sname search pattern FILSNM: JUMPN B,.+3 MOVE B,MSNAME SETO E, PUSHJ P,PSHSNM MOVSI 'DSK SKIPN LISTF ; if in LISTF, MOVEM PFILE ; this clobbers the print defaults JRST PARSE PSHSNM: CAME E,[-1] ; if starred, dups are flushed during search JRST PSHSN1 ; eliminate duplicates in non-starred snames PUSH P,A MOVE A,DP HRRI A,DPDL-1 ; wander through names already pushed PSHSNL: CAMN A,DP ; done? JRST PSHSN3 ; yes, name is new CAME B,1(A) ; same? JRST PSHSN2 ; no, move to next MOVE 2(A) ; same mask? CAME E ; E/ -1 at this point JRST PSHSN2 ; star mask, false alarm POP P,A ; here is duplicate, so just return POPJ P, PSHSN2: ADDI A,2 ; move to next entry JRST PSHSNL PSHSN3: POP P,A PSHSN1: PUSH DP,B ; push an sname search pattern ANDM E,(DP) PUSH DP,E SUB DP,[1,,0] POPJ P, ; here to process special switches. these are input as / ; but through the magic of GETSYL are output as /. ; same for &, of course. READSW: CAIN A,'/ MOVE A,[SWOR] CAIN A,'& MOVE A,[SWAND] MOVEM A,SWTYPE ; / or & -- OR or AND MOVEM A,SWDEV ; enters here after not READTY: JUMPE B,SYNERR ; bad switchname MOVE C,SWPTR SWLOOK: CAMN B,(C) ; dispatch on switchname JRST SWFIND ; got one ADDI C,1 AOBJN C,SWLOOK JRST SYNERR SWFIND: XCT 1(C) ; go off to handle switch's JRST PARSE ; special arguments SWTYPE: SWAND ; AND or OR switch? SWDEV: SWAND ; switch for devices ; both default and normal OR SWNOR: TLC D,%MATCH SWOR: IORM D,(ALT) SWEND: HRLZI %FOUND IORM (ALT) POPJ P, ; normal AND, invokes default if new object SWNAND: TLC D,%MATCH SWAND: CAMN FP,FPSAVE ; if first switch is just like or JRST SWOR MOVE (ALT) TLNN %FOUND JRST SWEND HRRI D,-1 TLO D,%NATCH ; lets not clobber, hey? ANDM D,(ALT) JRST SWEND ; macro defining command table DEFINE COM DIS,NMS IRP NM,,[NMS] SIXBIT /!NM!/ PUSHJ P,DIS TERMIN TERMIN ; table of switches SWTABL: SIXBIT /NOT/ JRST SWNOT ; special hack to comp switches COM SIZEB,[S,SIZE,SIZEB] COM SIZEW,[SIZEW] COM EXTRA,[EXTRA] COM CDATE,[C,CDATE,DATE,CREATE] COM BETWEE,[BTW,BETWEE] COM SINCE,[SINCE] COM BEFORE,[BEFORE] COM ON,[ON] COM CTIME,[T,CTIME,TIME] COM RDATE,[R,RDATE,REF] COM TODAY,[TODAY] COM NEWBIN,[NEW] COM VERSIO,[V,VER,VERSIO] COM LINK,[L,LINK,LINKS] COM LINKTO,[TO] COM DUMPED,[DUMP,DUMPED] COM REAP,[REAP,PROTEC,SAFE] COM AUTHOR,[AUTHOR,AUTH] COM PACK,[PCK,PACK,DRIVE,DR] COM ALLOC,[ALLOCA,ALLOC] COM DELETE,[DELETE,DEL] COM OPENED,[OPEN,OPENED,WRITE] Com Brief,[B,Brief] ;>> ; special switches that work oddly COM TECO,[TECO] COM WORDS,[W,WORD,WORDS] COM FLOATS,[F,FLOAT,FLOATS] COM TOTALS,[TOTALS,TOTAL,SUM,SUMMAR] COM FLPRNT,[PRINT,PR] COM NOFILE,[NOFILE,NOLIST,NOLF] COM DSKDEV,[DSK,DISK,DEVICE] COM ARCDEV,[ARC,ARCHIV] COM ORFIND,[FIND,OR,ELSE] SWPTR: -<<.-SWTABL>/2>,,SWTABL SWNOT: CAIN A,SWOR MOVEI A,SWNOR CAIN A,SWAND MOVEI A,SWNAND MOVEM A,SWTYPE PUSHJ P,GETSYL CAIE A,': JRST READTY MOVEI A,SWNAND MOVEM A,SWDEV PUSHJ P,DEVICE JRST PARSE ; push the details after pushing a test instruction ; FP points to the test instructions, TP contains them ; and the data areas they use. TPUSH: PUSH FP,TP PUSH TP,SWTYPE POPJ P, NOFILE: SETOM NOLIST' ; don't print listf lines POPJ P, WORDS: SETOM WRDFLG' ; print total words in LF lines POPJ P, FLOATS: SETOM FLTFLG' POPJ P, TOTALS: SETOM TOTFLG' ; total blocks, links, etc. POPJ P, FLPRNT: SETOM FLPRT' POPJ P, TECO: SETOM TECFLG' ; print file names as for teco POPJ P, ; =================================================================== ; size switch ; =================================================================== SIZEB: PUSH TP,[PUSHJ P,QSIZEB] TPRANG: PUSHJ P,TPUSH PUSHJ P,RRANGE POPJ P, QSIZEB: PUSH P,K MOVE A,C PUSHJ P,QLINK SKIPA JRST QSLOSE PUSHJ P,FILLEN QSEND: MOVE A,K XCT 2(TP) SKIPA AOS -1(P) QSLOSE: POP P,K POPJ P, SIZEW: PUSH TP,[PUSHJ P,QSIZEW] JRST TPRANG QSIZEW: PUSH P,K MOVE A,C PUSHJ P,QLINK SKIPA JRST QSLOSE PUSHJ P,FILWRD JRST QSEND EXTRA: PUSH TP,[PUSHJ P,QEXTRA] JRST TPRANG QEXTRA: PUSH P,K MOVE A,C PUSHJ P,QLINK SKIPA JRST QSLOSE LDB K,[301200,,UNRNDM(A)] JUMPE K,QSEND SUBI K,1024. MOVMS K JRST QSEND ; =================================================================== ; random cdate switches ; =================================================================== BETWEE: PUSHJ P,DFUNNY PUSHJ P,RB POPJ P, SINCE: PUSHJ P,DFUNNY PUSHJ P,RG POPJ P, BEFORE: PUSHJ P,DFUNNY PUSHJ P,RL POPJ P, ON: PUSHJ P,DFUNNY PUSHJ P,RE POPJ P, DFUNNY: PUSH TP,[PUSHJ P,QCDATE] PUSHJ P,TPUSH MOVE A,[PUSHJ P,GETDAT] MOVEM A,RANGER POPJ P, TODAY: PUSH TP,[PUSHJ P,QCDATE] PUSHJ P,TPUSH PUSH TP,[PUSHJ P,QE] PUSH TP,DATNOW POPJ P, ; =================================================================== ; real cdate switch ; =================================================================== CDATE: PUSH TP,[PUSHJ P,QCDATE] PUSHJ P,TPUSH PUSHJ P,DRANGE POPJ P, QCDATI: SKIPA A,UNDATE(C) ; here to compare date/time QCDATE: HLLZ A,UNDATE(C) ; here to compare only date TRZ A,1 ; ignore 1/2 seconds XCT 2(TP) POPJ P, AOS (P) POPJ P, ; =================================================================== ; time switch ; =================================================================== CTIME: PUSH TP,[PUSHJ P,QCTIME] PUSHJ P,TPUSH PUSHJ P,TRANGE POPJ P, QCTIME: LDB A,[UNTIM+UNDATE(C)] XCT 2(TP) POPJ P, AOS (P) POPJ P, ; =================================================================== ; reference date switch ; =================================================================== RDATE: PUSH TP,[PUSHJ P,QRDATE] PUSHJ P,TPUSH PUSHJ P,DRANGE POPJ P, QRDATE: HLLZ A,UNREF(C) XCT 2(TP) POPJ P, AOS (P) POPJ P, ; ======================================================== ; read ranges ; ======================================================== TRANGE: MOVE A,[PUSHJ P,GETTIM] ; read times JRST .+3 DRANGE: SKIPA A,[PUSHJ P,GETDAT] ; read dates RRANGE: MOVE A,[PUSHJ P,GETNUM] ; read numbers MOVEM A,RANGER PUSH P,COMPTR ; possibility of backing up PUSHJ P,GETSYL MOVE A,RNGPTR RRLOOP: CAME B,(A) JRST RRNEXT POP P,0 ; real switch, advance PUSHJ P,@1(A) POPJ P, RRNEXT: ADDI A,1 AOBJN A,RRLOOP SETZM SLASH SETZM AMPERS POP P,COMPTR ; not a recognized switch ; try re-reading it as an EQ switch ; like EQ if just number PUSHJ P,RE POPJ P, ; table of range indicators RNGTBL: COM RG,[>,GT,GREATE,SINCE,AFTER] COM RL,[<,LT,LESS,LESSER,BEFORE] COM RE,[=,EQ,EQUAL,SAME,ON] COM RB,[B,BTW,BETWEE] RNGPTR: -<<.-RNGTBL>/2>,,RNGTBL ; =================================================================== ; read various sorts of ranges ; =================================================================== RANGER: PUSHJ P,GETNUM ; how to interpret numbers of range RG: PUSH TP,[PUSHJ P,QG] JRST RRNG RL: PUSH TP,[PUSHJ P,QL] JRST RRNG RE: PUSH TP,[PUSHJ P,QE] RRNG: XCT RANGER JRST SYNERR RRNG1: PUSH TP,B POPJ P, ; read two parts of a "between" statement RB: PUSH TP,[PUSHJ P,QBTW] XCT RANGER JRST SYNERR PUSH TP,B XCT RANGER JRST SYNERR MOVE RANGER ; special default kludge for reading date: ; if says /BTW 5/17 10:30 11:30 should do default... CAME [PUSHJ P,GETDAT] ; date? JRST .+3 TLNN B,-1 ; day given? HLL B,(TP) ; no, use default ; order of compare is greatest first CAMG B,(TP) EXCH B,(TP) JRST RRNG1 ; jump to common range code ; =================================================================== ; test various ranges ; =================================================================== QG: CAMLE A,3(TP) AOS (P) POPJ P, QL: CAMGE A,3(TP) AOS (P) POPJ P, QE: CAMN A,3(TP) AOS (P) POPJ P, QBTW: CAML A,3(TP) CAMLE A,4(TP) POPJ P, AOS (P) POPJ P, ; =================================================================== ; links switch ; =================================================================== ; search only for links LINK: PUSH TP,[PUSHJ P,QLINK] PUSHJ P,TPUSH POPJ P, ; link test routine QLINK: PUSH P,A MOVE A,(ALT) MOVE A,(A)UNRNDM TLNE A,UNLINK ; is it a link? AOS -1(P) POP P,A POPJ P, ; =================================================================== ; link to switch ; =================================================================== ; search only for links to a given file LINKTO: MOVEI D,FONE PUSHJ P,SCNAME ; read the file name PUSH TP,[PUSHJ P,LSTAR] PUSHJ P,TPUSH PUSH TP,FONE+1 PUSH TP,MONE PUSH TP,FONE+2 PUSH TP,MONE+1 PUSH TP,FONE+3 PUSH TP,MONE+2 POPJ P, ; =================================================================== ; reap bit switch ; =================================================================== REAP: PUSH TP,[PUSHJ P,QREAP] PUSHJ P,TPUSH POPJ P, QREAP: MOVE A,UNRNDM(C) TLNE A,UNREAP AOS (P) POPJ P, ; =================================================================== ; save state switch ; =================================================================== ORFIND: PUSH TP,[SKIPA] ; always succeeds PUSH FP,TP PUSH TP,[SWSAVE] POPJ P, ; here for saving current state SWSAVE: MOVE (ALT) TLNE %MATCH TLO %NATCH ; save state TLZ %MATCH+%FOUND MOVEM (ALT) POPJ P, ; to avoid %found hacking ; =================================================================== ; dump bit switch ; =================================================================== DUMPED: PUSH TP,[PUSHJ P,QDUMP] PUSHJ P,TPUSH POPJ P, ; skip if dumped QDUMP: PUSH P,A PUSHJ P,QLINK SKIPA A,(ALT) JRST QDUMPX SKIPGE UNRNDM(A) QDUMPX: AOS -1(P) POP P,A POPJ P, ; =================================================================== ; open switch ; =================================================================== OPENED: PUSH TP,[PUSHJ P,QOPEN] PUSHJ P,TPUSH POPJ P, QOPEN: PUSH P,A MOVE A,(ALT) MOVE A,UNRNDM(A) TLNE A,UNWRIT AOS -1(P) POP P,A POPJ P, ; =================================================================== ; deleted switch ; =================================================================== DELETE: PUSH TP,[PUSHJ P,QDELET] PUSHJ P,TPUSH POPJ P, ; skip if delete on close or deleted from unmounted pack QDELET: PUSH P,A MOVE A,(ALT) MOVE A,UNRNDM(A) TLNE A,UNCDEL AOS -1(P) POP P,A POPJ P, ; =================================================================== ; allocated dir? ; =================================================================== ALLOC: PUSH TP,[PUSHJ P,QALLOC] PUSHJ P,TPUSH POPJ P, ; file on allocated pack? QALLOC: SKIPE DIRBUF+UDALLO ; what a kludge!!! AOS (P) POPJ P, ; =================================================================== ; pack number ; =================================================================== PACK: PUSHJ P,GETNUM JRST SYNERR SPACK: PUSH TP,[PUSHJ P,QPACK] PUSHJ P,TPUSH PUSH TP,B POPJ P, QPACK: PUSHJ P,QLINK ; fie on links SKIPA POPJ P, PUSH P,A MOVE A,(ALT) LDB A,[UNPKN+UNRNDM(A)] CAMN A,2(TP) AOS -1(P) POP P,A POPJ P, VERSIO: PUSHJ P,GETNUM JRST SYNERR PUSH TP,[PUSHJ P,QVERSI] PUSHJ P,TPUSH PUSH TP,B POPJ P, QVERSI: PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,F MOVE B,(C) MOVE A,1(C) PUSHJ P,NUMERI JRST VRSXI1 MOVE F,2(TP) ; VERSION COUNT SOJE F,QVRWIN ; JUMP IF ALREADY ZERO (IDIOT SAID 1) ;now loop looking for newer ones with same first name PUSH P,ALT ; SAVE CURRENT PTR INTO DIR PUSHJ P,ATOP ; TOP IT MOVE D,ALT ; INTO D MOVE ALT,(P) ; RESTORE OLD PTR VRSBCK: CAMN D,ALT ; REACHED TOP OF DIR JRST VRSNXT SUB ALT,[1,,1] ; LOOK BACKWARDS FOR MATCHES MOVE E,(ALT) CAME B,(E) ; SAME NM1? JRST VRSNXT ; NOPE, TRY MOVING FORWARDS MOVE A,1(E) ; GET NM2 PUSHJ P,NUMERI JRST VRSBCK SOJE F,QVRWIN ; COUNT OF VERSIONS JRST VRSBCK VRSNXT: MOVE ALT,(P) VRSNX1: AOBJP ALT,VRSXIT MOVE E,(ALT) CAME B,(E) JRST VRSXIT MOVE A,1(E) PUSHJ P,NUMERI JRST VRSNX1 SOJE F,QVRWIN JRST VRSNX1 QVRWIN: AOS -7(P) VRSXIT: POP P,ALT VRSXI1: POP P,F POP P,E POP P,D POP P,C POP P,B JRST POPAJ NEWBIN: PUSHJ P,GETSYL PUSH TP,[PUSHJ P,QNEWBI] PUSHJ P,TPUSH PUSH TP,B PUSH TP,E POPJ P, QNEWBI: PUSH P,A MOVE (ALT) MOVE A,1(C) ; GET FNM2 AND A,3(TP) ; MASK MOVE 2(TP) ; MATCH NAME (E.G., NBIN) AND 3(TP) ; MASK, AGAIN CAME A, ; MATCH? JRST POPAJ ; NOPE, FORGET IT MOVE A,UNDATE(C) ; GET DATE OF MATCH INTO A PUSH P,B PUSH P,C PUSH P,D PUSH P,E MOVE B,(C) ; FIRST NAME INTO B ;now loop looking for newer ones with same first name PUSH P,ALT ; SAVE CURRENT PTR INTO DIR PUSHJ P,ATOP ; TOP IT MOVE D,ALT ; INTO D MOVE ALT,(P) ; RESTORE OLD PTR NWBBCK: CAMN D,ALT ; SAME FILE CAN'T MATCH JRST NWBNXT SUB ALT,[1,,1] ; LOOK BACKWARDS FOR MATCHES MOVE E,(ALT) CAME B,(E) ; SAME NM1? JRST NWBNXT ; NOPE, TRY MOVING FORWARDS MOVE UNRNDM(E) TLNE UNLINK PUSHJ P,NWBLNK ; do obscenity for links MOVE 0,UNDATE(E) NWBBC1: CAML A, JRST NWBBCK PUSH P,A MOVE A,1(E) PUSHJ P,NUMERI SKIPA PUSHJ P,NWBWIN POP P,A JRST NWBBCK NWBLNK: .CALL [SETZ SIXBIT /OPEN/ [0] FONE (E) 1(E) SETZ FONE+3] POPJ P, .CALL [SETZ 'RFDATE MOVEI 0 SETZM 0] POPJ P, AOS (P) POPJ P, NWBNXT: MOVE ALT,(P) NWBNX1: AOBJP ALT,NWBXIT MOVE E,(ALT) CAME B,(E) JRST NWBXIT MOVE UNRNDM(E) TLNE UNLINK PUSHJ P,NWBLNK ; do obscenity for links MOVE 0,UNDATE(E) CAML A, JRST NWBNX1 PUSH P,A MOVE A,1(E) PUSHJ P,NUMERI SKIPA PUSHJ P,NWBWIN POP P,A JRST NWBNX1 NWBXIT: POP P,ALT POP P,E POP P,D POP P,C POP P,B POPAJ: POP P,A POPJ P, NWBWIN: PUSH P,D HRLZI D,%MATCH PUSHJ P,@1(TP) POP P,D POPJ P, ; skip return if fnm in A is numeric. i.e., at least one trailing digit. NUMERI: PUSH P,B SETZ B, NUMER2: LDB [0600,,A] JUMPE NUMER1 CAIL '0 CAILE '9 JUMPE B,NUMER3 SETO B, NUMER1: LSH A,-6 JUMPN A,NUMER2 SKIPE B AOS -1(P) NUMER3: POP P,B POPJ P, ; =================================================================== ; author switch ; =================================================================== AUTHOR: PUSHJ P,GETSYL PUSH TP,[PUSHJ P,QAUTHO] PUSHJ P,TPUSH CAMN B,[SIXBIT /?/] MOVEI B,777 PUSH TP,B SETOM AUTFLG' POPJ P, QAUTHO: PUSH P,A MOVE A,(ALT) LDB A,[UNAUTH+UNREF(A)] JUMPE A,QNAUTH CAIN A,777 ; random JRST QRAUTH LSH A,1 ADDI A,MFDBUF+2000 SUB A,MDNUDS+MFDBUF SUB A,MDNUDS+MFDBUF MOVE A,(A) QRAUTH: CAMN A,2(TP) AOS -1(P) QNAUTH: POP P,A POPJ P, ; ====================================================================== ; brief switch (simplicity itself - >>) ; ====================================================================== BriefP: 0 ;0=No, be verbose BCount: 0 ;Count of # u/j pairs we've done across Brief: Setcmm BriefP ;Toggle brief value Popj P, ; =================================================================== ; command line reading and parsing section ; =================================================================== ; read a file spec SCNAME: SETZM 4(D) SETZM 5(D) PUSH P,B PUSH P,C PUSH P,E MOVSI C,-2 HRRI C,1(D) SCNGET: PUSHJ P,GETSYL JUMPE B,SCNX CAIN A,': MOVEM B,(D) CAIE A,'; JRST .+3 MOVEM B,3(D) MOVEM E,6(D) CAIE A,'_ JUMPG A,SCNGET MOVEM B,(C) MOVEM E,3(C) JUMPL A,SCNX ; terminator? SKIPN LEFTAR JRST .+3 CAIN A,'_ JRST SCNX CAIE A,', AOBJN C,SCNGET SCNX: POP P,E POP P,C POP P,B POPJ P, ; ==================================================================== ; read a time ; ==================================================================== HRS: 0 MIN: 0 SEC: 0 GETTIM: PUSH P,C PUSH P,D PUSH P,COMPTR SETZM HRS SETZM MIN SETZM SEC SETZB C,B TLO C,400000 ; nothing read yet MOVE D,[-4,,HRS] GETTLP: PUSHJ P,GETCCA SUBI A,40 JUMPLE A,GETTIX CAIL A,'0 CAILE A,'9 JRST TOTNUM SUBI A,'0 TLZ C,400000 IMULI C,10. ADD C,A JRST GETTLP TOTNUM: CAIE A,': JRST GETTLS ; can't grok it JUMPL C,GETTLS AOBJP D,GETTLS MOVEM C,-1(D) MOVSI C,400000 JUMPE B,TIMSEP CAME A,B JRST GETTLS TIMSEP: MOVE B,A ; here he gave a separator JRST GETTLP GETTIX: JUMPL C,GETTLS AOBJP D,GETTLS MOVEM C,-1(D) MOVE A,HRS CAILE A,24. JRST GETTLS MOVE B,A MOVE A,MIN CAIL A,60. JRST GETTLS IMULI B,60. ADD B,A MOVE A,SEC CAIL A,60. JRST GETTLS IMULI B,60. ADD B,A LSH B,1 ; don't forget stupid 1/2 seconds POP P,0 AOSA -2(P) GETTLS: POP P,COMPTR SETZM SLASH SETZM AMPERS POP P,D POP P,C POPJ P, ; ================================================================== ; read a date ; ================================================================== YY==HRS MM==MIN DD==SEC GETDAT: PUSH P,C PUSH P,D PUSH P,COMPTR ; allow for failure SETZB C,B TLO C,400000 ; nothing read yet MOVE D,[-4,,YY] ; aobjn to slots of date GETDLP: PUSHJ P,GETCCA ; read a character SUBI A,40 ; convert to sixbit JUMPLE A,GETDAX ; if was control, jump CAIL A,'0 CAILE A,'9 JRST NOTNUM SUBI A,'0 ; here its a number TLZ C,400000 ; we have now read something IMULI C,10. ADD C,A ; build number and loop JRST GETDLP ; here character is not a number NOTNUM: CAIN A,': JRST GETDL1 ; maybe it's a time? CAIE A,'. CAIN A,'/ SKIPA JRST GETTDY JUMPL C,GETDLS AOBJP D,GETDLS ; this would be fourth?? MOVEM C,-1(D) MOVSI C,400000 JUMPE B,DATSEP CAME A,B ; must be same as last sep. JRST GETDLS DATSEP: MOVE B,A ; here he gave a separator JRST GETDLP GETDAX: JUMPL C,DATHRE ; space is only interesting one AOBJP D,GETDLS MOVEM C,-1(D) ; put it out, now fix up result DATHRE: CAMG D,[-1,,0] ; three given? JRST DATTWO CAIN B,'. ; if period, already ordered right JRST DATDEF CAIE B,'/ JRST GETDLS MOVE A,YY ; change mmddyy to yymmdd EXCH A,MM EXCH A,DD MOVEM A,YY JRST DATDEF DATTWO: CAMG D,[-2,,0] JRST DATONE MOVE A,YY CAILE A,31. JRST DATDEF MOVE A,MM CAIG A,31. JRST TWOMD EXCH A,YY MOVEM A,MM JRST DATDEF TWOMD: MOVEM A,DD MOVE A,YY MOVEM A,MM SETZM YY JRST DATDEF DATONE: MOVE A,YY CAILE A,31. CAIL A,100. SKIPA JRST DATDEF IDIVI A,100. MOVEM B,DD IDIVI A,100. MOVEM B,MM MOVEM A,YY DATDEF: SETZ D, MOVE C,DATNOW ; current date is default SKIPN B,YY JRST DEFMM DPB B,[UNYRB+C] DPB D,[UNMON+C] DPB D,[UNDAY+C] DEFMM: SKIPN B,MM JRST DEFDD CAILE B,12. JRST GETDLS DPB B,[UNMON+C] DPB D,[UNDAY+C] DEFDD: SKIPN B,DD JRST DEFEND CAILE B,31. JRST GETDLS DPB B,[UNDAY+C] DEFEND: POP P,0 ; here on assumption he gives a time too (C contains date read) GETDTQ: PUSH P,COMPTR ; fail point if want to restore comptr PUSHJ P,GETTIM JRST GETDTL ; not a time, so lose GETDT1: MOVE D,(FP) MOVE [PUSHJ P,QCDATI] MOVEM (D) ; clobber the test instruction POP P,0 ; is a time, so keep updated comptr HRR C,B ; combine GETDX1: MOVE B,C ; recover date-time to B AOS -2(P) ; skip return JRST GETDAF GETDLS: POP P,COMPTR ; here if not a date SETZM SLASH SETZM AMPERS GETDAF: POP P,D ; restore acs and return POP P,C POPJ P, GETDL1: POP P,COMPTR PUSH P,COMPTR PUSHJ P,GETTIM ; here if it looks like its a time JRST GETDLS JRST GETDT1 ; reenter at normal processing for a time GETDTL: POP P,COMPTR ; not a time, so just return date JRST GETDX1 ; still skip, date was good ; here if might be "today" GETTDY: POP P,COMPTR PUSHJ P,GETSYL CAME B,[SIXBIT /TODAY/] JRST GETDAF MOVE C,DATNOW JRST GETDTQ ; now try to read a time ; ============================================================== ; read a number, skip if is, no skip if not ; ============================================================== GETNUM: SETZ B, GETNL: PUSHJ P,GETCCA JUMPLE A,GETNMX CAIE A," JRST .+3 GETNMX: AOS (P) POPJ P, CAIL A,"0 CAILE A,"9 POPJ P, SUBI A,"0 IMULI B,10. ADD B,A JRST GETNL ; get a syllable from command buffer GETSYL: PUSH P,C PUSH P,[0] MOVEI B,(P) PUSH P,[-1] MOVEI C,(P) HRLI B,440600 HRLI C,440600 GETSLP: PUSHJ P,GETCCA JUMPL A,GETSX SETO E, CAIE A,^X ; ^X maps into DDT default nm1 JRST GETSL1 MOVE B,PFILE+2 GETSL3: MOVEM B,-1(P) ; set up word read SETZ A, JRST GETSX GETSL1: CAIE A,^Y ; ^Y maps into DDT default nm2 JRST GETSL2 MOVE B,PFILE+3 JRST GETSL3 GETSL2: CAIN A,^Q ; ^Q quotes next character JRST GETQOT SUBI A,40 JUMPL A,GETSX ; other controls exit JUMPE A,GETSP ; space? ; character > ascii 40 octal SKIPE LEFTAR JRST GETUND CAIN A,'& JRST GETAMP CAIN A,'/ JRST GETSLA GETUND: SKIPN LEFTAR JRST GETSTA CAIN A,'_ JRST GETSX GETSTA: CAIN A,'* SETZ E, CAIE A,', CAIN A,'+ JRST GETSX CAIE A,': CAIN A,'; JRST GETSX GETSPT: CAIL A,100 SUBI A,40 TLNN B,770000 JRST GETSLP IDPB A,B IDPB E,C JRST GETSLP GETAMP: SETZ A, SKIPE AMPERS MOVEI A,'& SKIPE SLASH MOVEI A,'/ SETOM AMPERS SETZM SLASH JRST GETFOO GETSLA: SETZ A, SKIPE AMPERS MOVEI A,'& SKIPE SLASH MOVEI A,'/ SETOM SLASH ; next syl is slashed SETZM AMPERS GETFOO: HLRZ B ; win if & is first found CAIE 440600 JRST GETSX2 JUMPN A,SYNERR JRST GETSLP GETQOT: ILDB A,COMPTR SUBI A,40 JUMPGE A,GETSPT JRST GETSX GETSP: TLNE B,400000 JRST GETSLP GETSX: SKIPN SLASH JRST GETSX1 MOVEI A,'/ SETZM SLASH JRST GETSX2 GETSX1: SKIPN AMPERS JRST GETSX2 MOVEI A,'& SETZM AMPERS GETSX2: POP P,E ; star word POP P,B ; character word POP P,C AOS SYLCNT CAMN B,STAR CAME E,[SIXBIT / _____/] POPJ P, SETZ E, POPJ P, SLASH: 0 ; slash switch AMPERS: 0 ; ampersand switch GETCCA: ILDB A,COMPTR JUMPE A,GETCCX CAIN A,^I MOVEI A,40 CAIN A,^M JRST GETCCX CAIN A," SETOM NODEFL POPJ P, GETCCX: SETOM A POPJ P, ; find out length of file ; takes pointer to name area in A ; length in words returned in K FILWRD: PUSH P,A PUSHJ P,FILLEN JUMPE K,FILWXT LDB A,[301200,,UNRNDM(A)] SKIPE A SUBI K,1 IMULI K,1024. ADD K,A FILWXT: POP P,A POPJ P, ; length in blocks returned in K FILLEN: PUSH P,A PUSH P,B MOVE K,@THEDIR CAMN K,[SIXBIT /ARC1!!/] JRST [SETZ K, ? JRST POPBAJ] LDB A,[UNDSCP+UNRNDM(A)] ANDI A,17777 IDIVI A,UFDBPW ADDI A,UDDESC ADD A,THEDIR HLL A,BYTPTR(B) SETZI K, AFLLN1: ILDB B,A JUMPE B,POPBAJ CAILE B,UDTKMX JRST AFLLN2 ADD K,B JRST AFLLN1 AFLLN2: CAIGE B,UDWPH AOJA K,AFLLN1 CAIN B,UDWPH JRST AFLLN1 IBP A IBP A AOJA K,AFLLN1 POPBAJ: POP P,B POP P,A POPJ P, ; build the spec of the file pointed to by a link ; skip returns if file is a link, with snm nm1 nm2 in first three ; words of LNKBUF LNKFIL: PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,F PUSH P,M MOVE M,A MOVE A,(M)UNRNDM TLNN A,UNLINK ; is it a link? JRST LNKNOT ; no, do normal cruft ; here if file is a link ; here to build name of file linked to ANDI A,17777 IDIVI A,UFDBPW ADDI A,UDDESC ADD A,THEDIR HLL A,BYTPTR(B) MOVE F,BYTPTR SETZB B,C SETZB D,E QL1: ILDB 0,A JUMPE 0,QL3 CAIN 0,': SOJL E,QL4 CAIN 0,'; SOJL E,QL2 QL5: IDPB 0,F JRST QL1 QL2: TLZ F,770000 JRST QL1 QL4: MOVEI E,1 JRST QL1 QL3: SOJGE E,QL5 MOVEM B,LNKBUF+2 MOVEM C,LNKBUF MOVEM D,LNKBUF+1 AOS -6(P) LNKNOT: POP P,M POP P,F POP P,E POP P,D POP P,C POP P,B POPJ P, ; ================================================================ ; listf line file spec printer ; ================================================================ LFPRN1: SETZM HPOS SKIPA LFPRNT: JUMPE DIR,[POPJ P,] PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,F PUSH P,H PUSH P,K PUSH P,M MOVE M,A PUSHJ P,LNKFIL JRST RSTLIN ; for non-links ; file is a link AOS LINKS SKIPE NOLIST JRST ENDLIN Skipe BriefP ;>> Jrst [Pushj P,BPrint Jrst Endlin] OSIXS [SIXBIT/ L /] OSIXS UNFN1(M) OASCI " OSIXS UNFN2(M) OHPOS 22. ; here to print file linked to OSIX LNKBUF+2 OASCI "; OSIX LNKBUF OASCI " OSIX LNKBUF+1 OHPOS 43. ; up to 20 chars worth of link dest. JRST DATPRT ; skip over !$ bits, links don't need them ; here to print normal file RSTLIN: AOS FILES SKIPE NOLIST JRST SIZPRT Skipe BriefP ;>> Jrst [Pushj P,BPrint Jrst Endlin] ; print del/open/etc. bit LDB B,[220600,,UNRNDM(M)] TRNE B,UNIGFL OASCI "* TRNE B,40 ; secret bit! OASCI "? ; print pack number OHPOS 2. LDB B,[150500,,UNRNDM(M)] ODEC B ; print file names OHPOS 6. OSIXS UNFN1(M) OASCI " OSIXS UNFN2(M) ; print file blocks and extra words SIZPRT: MOVE A,M PUSHJ P,FILLEN ; takes pointer in A to name area ADDM K,BLOCKS SKIPE NOLIST JRST ENDLIN MOVE A,@THEDIR CAMN A,[SIXBIT /ARC1!!/] JRST [OASC [ASCIZ / -- /] JRST BITPRT] LDB A,[301200,,UNRNDM(M)] SKIPE WRDFLG ; -1 ==> total words JRST SIZWRD SKIPE A SUBI K,1 OALIGN 4,K ; right align in 3 spaces SKIPE FLTFLG JRST SIZFLT JUMPE A,[MOVE A,HPOS OHPOS 5(A) ; move right 5 spaces JRST BITPRT] OSIGN 5,A ; right align (w. +) in 5 spaces JRST BITPRT SIZFLT: JUMPN A,SIZFL1 OASC [ASCIZ /.0 /] JRST BITPRT SIZFL1: IMULI A,1000. IDIVI A,1024. CAILE B,512. ADDI A,1 CAIN A,100. SUBI A,1 OASCI ". ODEC 3,A JRST BITPRT ; print size as total number of words in file SIZWRD: SKIPE A SUBI K,1 SKIPE K IMULI K,1024. ADD K,A OALIGN 7,K BITPRT: OASCI " MOVE A,UNRNDM(M) MOVEI K," TLNE A,UNREAP MOVEI K,"$ OASCI (K) MOVSI K,(ASCIZ/! /) SKIPL A,UNRNDM(M) TLNE A,UNLINK MOVSI K,(ASCIZ/ /) ; undumped bit OASC K ; print date and time of creation, reference DATPRT: MOVE H,HPOS ; save current hpos AOSN (M)UNDATE JRST [OASC [ASCIZ /--/] JRST REFPRT] SOS (M)UNDATE LDB K,[270400,,(M)UNDATE] ODEC K OASCI "/ LDB K,[220500,,(M)UNDATE] ODEC K OASCI "/ LDB K,[330700,,(M)UNDATE] ODEC K OASCI " HRRZ B,(M)UNDATE MOVEI A,3 SETZI D, LSH B,-1 TILOP: IDIVI B,10. ADDI C,'0 LSHC C,-6 IDIVI B,6 ADDI C,'0 LSHC C,-6 SOJG A,TILOP MOVEI B,2 MOVEI A,": TILOP2: SETZI C, LSHC C,6 OASCI 40(C) SETZI C, LSHC C,6 OASCI 40(C) SKIPE B OASCI (A) SOJGE B,TILOP2 ; print reference date, if any REFPRT: LDB K,[222000,,UNREF(M)] JUMPE K,AUTPRT OHPOS 18.(H) ; relative to start of date OASCI "( LDB K,[270400,,UNREF(M)] ODEC K OASCI "/ LDB K,[220500,,UNREF(M)] ODEC K OASCI "/ LDB K,[330700,,UNREF(M)] ODEC K OASCI ") ; print creator if not sname AUTPRT: LDB K,[UNAUTH+UNREF(M)] JUMPE K,ENDLIN CAIN K,777 ; random JRST [MOVE B,[SIXBIT /-??-/] JRST AUTOUT] LSH K,1 ADDI K,MFDBUF+2000 SUB K,MDNUDS+MFDBUF SUB K,MDNUDS+MFDBUF MOVE B,(K) AUTOUT: OHPOS 28.(H) ; relative to start of date MOVE C,THEDIR MOVE C,2(C) ; directory name HLRZ A,PFILE CAIE A,'DSK MOVE C,PFILE+1 ; arc's don't have that slot CAME B,C OSIX B ; print crlf and return ENDLIN: SKIPN NOLIST Skipe BriefP Skipa OASCR [0] SKIPE FLPRT PUSHJ P,FILPRT POP P,M POP P,K POP P,H POP P,F POP P,E POP P,D POP P,C POP P,B POP P,A POPJ P, FILPRT: SETOM INPRT' PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,E MOVE A,PFILE MOVE B,DISK CAMN B,[SIXBIT /DSK/] JRST PROPEN MOVE A,PFILE LSH A,-14 IOR A,B PROPEN: .CALL FILOPN JRST OPFAIL PRLOOP: MOVE A,[-2000,,BUFFER] .IOT DSKBI,A MOVEI C,<5*2000> JUMPGE A,PROUT .CLOSE DSKBI, HRRZ D,A SUBI D,BUFFER IMULI D,5 ; max in this buffer MOVEI B,-2(A) CAIGE B,BUFFER-1 MOVEI B,BUFFER ; beginning of buffer MOVE C,B SUBI C,BUFFER IMULI C,5 HRLI B,440700 PRCTRL: ILDB 0,B CAIE 0,^C CAIN 0,^L SKIPA JUMPN 0,PRAOS JRST PROUT PRAOS: CAME C,D AOJA C,PRCTRL PROUT: MOVE E,C MOVE B,[440700,,BUFFER] .CALL [SETZ SIXBIT /SIOT/ MOVSI %TJDIS MOVEI TYOC B E SETZB LSTERR] JRST PREXIT JUMPG A,PRLOOP JRST PREXIT PRTFLS: .IOT TYOC,[^M] ; here on ^S during typeout .IOT TYOC,[^J] JRST PREXIT OPFAIL: OASC [ASCIZ /File not found??/] PREXIT: SETOM MORLOK ; says dismiss more interrupts immediately .CLOSE DSKBI, ; ecology! .IOT TYOC,[^M] .IOT TYOC,[^J] OASC [ASCIZ /--Next File--/] MOVEI A,1 MOVEM A,INPRT ; finished printing, but not quite... PRTFL1: .RESET TYIC, ; flush extraneous type-ahead .IOT TYIC,A CAIE A,40 ; space and rubout continue CAIN A,177 SKIPA JRST EXIT ; anything else flushes SETZM INPRT SETZM MORLOK ; allow mores POP P,E POP P,D POP P,C POP P,B POP P,A POPJ P, FILOPN: SETZ SIXBIT /OPEN/ MOVSI 12 MOVEI DSKBI A UNFN1(M) UNFN2(M) SETZ FONE+3 ; table of sixbit byte pointers BYTPTR: 440600,,B 360600,, 300600,, 220600,, 140600,, 60600,, ; ================================================================ ; file spec matching ; ================================================================ ; star matching routine for normal files ; C/ pointer to file block of possible match ; TP/ xx ; xx ; nm1 ; msk1 ; nm2 ; msk2 COMCHK: MOVE A,(C) CAMN A,COMDEF+1 AOS (P) POPJ P, MSTAR: MOVE A,2(TP) CAME A,[SIXBIT /> /] CAMN A,[SIXBIT /< /] JRST MATCH2 ; > and < always match AND A,3(TP) MOVE 0,(C) AND 0,3(TP) CAME A,0 POPJ P, MOVE A,(C) MATCH2: MOVE B,4(TP) CAME B,[SIXBIT /> /] CAMN B,[SIXBIT /< /] JRST MSTARW AND B,5(TP) MOVE 0,1(C) AND 0,5(TP) CAMN B,0 MSTARW: AOS (P) POPJ P, ; routine to find files which are links to a given file ; C/ pointer to possibility LSTAR: PUSH P,B PUSH P,C MOVE A,C PUSHJ P,LNKFIL JRST LSTARX MOVEI C,LNKBUF MOVE B,6(TP) AND B,7(TP) MOVE 0,2(C) ; sname AND 0,7(TP) CAME B,0 JRST LSTARX PUSHJ P,MSTAR JRST LSTARX AOS -2(P) LSTARX: POP P,C POP P,B POPJ P, ; ================================================================ ; mark matching files ; ================================================================ MARK: PUSH P,A PUSH P,B PUSH P,C PUSH P,D ; now get right pointer for current dir of travel MOVE ALT,DIR PUSHJ P,ATOP SEALU2: MOVE C,(ALT) HRLZI D,%MATCH XCT (TP) ; matcher routine SETZ D, ; failure return ; here its a match PUSH P,ALT PUSHJ P,QLOOK ; returns dir ptr in A PUSHJ P,@1(TP) ; iorm OR andm (ALT) POP P,ALT PUSHJ P,ANEXT ; move to next file JRST SEALU2 ; skip return if ever found a match, return in ALT the topped dir MOVE ALT,DIR PUSHJ P,ATOP POP P,D POP P,C POP P,B POP P,A POPJ P, ; top a directory vector ATOP: PUSH P,A HRRZ A,ALT SUBI A,DIRVCT HRLS A SUB ALT,A POP P,A POPJ P, ANEXT: AOBJN ALT,[POPJ P,] SUB ALT,[1,,1] AOS (P) POPJ P, ; ================================================================ ; directory searching code (from ITS) ; ================================================================ QFNG: SKIPA C,[SETZ] QLOOK: MOVEI C,0 ; C/ name1 or name2? PUSH P,D PUSH P,H PUSH P,I PUSH P,J PUSH P,K HRRZ J,THEDIR ; file names in a,b ADD J,UDNAMP(J) ; is name1 or name2 > or /] TLOA J,400000 CAMN A,[SIXBIT / CAMN B,[SIXBIT />/] TLOA J,400000 CAMN B,[SIXBIT / or <, just return it JRST QLKLOS ; no > or < ; done! QLOOK2: JUMPL C,QFNG1 SUB P,[2,,2] MOVE K,(P) JUMPE K,QLKLO1 ; "find" all that match otherwise MOVE ALT,(P) PUSHJ P,ATOP QLKFND: MOVE K,(ALT) XCT QLKI1(C) ; skip if has same name as match JRST .+3 HRLZI 0,%FOUND IORM 0,(ALT) PUSHJ P,ANEXT JRST QLKFND QLKLO1: POP P,ALT ; winner! ; return one we found QLKLOS: POP P,K POP P,J POP P,I POP P,H POP P,D POPJ P, QFNG1: SKIPN -2(P) JRST QFNG2 ; NOT FOUND START W/ 1 MOVE H,-1(P) TLC H,400000 MOVE I,[600,,H] QFNG3: LDB D,I CAIL D,'0 CAILE D,'9 JRST QFNG4 ; REACH END OF NUMERIC FIELD ADDI D,1 CAILE D,'9 JRST QFNG5 DPB D,I QFNG5A: TLNE H,770000 JRST QFNG3A LSH H,6 JRST QFNG5A QFNG2: MOVSI H,(SIXBIT /1/) QFNG3A: MOVEM H,A(C) ; STORE INTO A OR B AS APPRO SUB P,[3,,3] JRST QLKLOS QFNG5: MOVEI D,'0 DPB D,I ADD I,[60000,,] JUMPL I,QFNG5A JRST QFNG3 QFNG4: TLNN H,770000 ; SKIP ON ALREADY 6 CHAR NAME LSH H,6 MOVEI D,'1 DPB D,I MOVEI D,'0 QFNG4B: TLNN I,770000 JRST QFNG5A IDPB D,I JRST QFNG4B ; actual search: ; C/ 0 = name1, 1 = name2 ; J/ 4.9 = 1, > ; = 0, < ; enter here if name1 is > <, C=0, 4.9 of J set if > QLOOKA: CAME B,[SIXBIT / or /] JRST QLKLOS ; lose ; enter here if name2 is > <, C=1, 4.9 bit of J set if > QLOOK1: PUSHJ P,ATOP PUSH P,[0] ; best index PUSH P,[SETZ] ; best "numeric" part PUSH P,[SETZ] ; best alpha part QLOOK4: MOVE K,(ALT) ;TLNE K,%FOUND ; don't care if already seen ;JUMPGE C,QLOOK3 XCT QLKI1(C) JRST QLOOK3 SKIPE H,@QLKI1+1(C) QLOOK6: TRNE H,77 ; right adj JRST QLOOK5 LSH H,-6 JRST QLOOK6 QLOOK5: MOVEI I,0 QLOOK8: LDB D,[600,,H] CAIL D,'0 CAILE D,'9 JRST QLOOK7 ; not a digit QLOK5B: TRNE I,77 ; right adj low non num part JRST QLOK5A LSH I,-6 JUMPN I,QLOK5B QLOK5A: TLC H,400000 ; avoid cam lossage TLC I,400000 SKIPN -2(P) JRST QLOK5D ; first match JUMPGE J,QLOK5E ; get least CAMGE H,-1(P) ; get greatest JRST QLOOK3 CAME H,-1(P) JRST QLOK5D CAMGE I,(P) JRST QLOOK3 ; not as good QLOK5D: MOVEM ALT,-2(P) MOVEM H,-1(P) MOVEM I,(P) QLOOK3: PUSHJ P,ANEXT JRST QLOOK4 ; loop ; end of dir, -2(p) contains match JRST QLOOK2 ; end of dir QLOK5E: CAMLE H,-1(P) JRST QLOOK3 CAME H,-1(P) JRST QLOK5D CAMLE I,(P) JRST QLOOK3 JRST QLOK5D QLOOK7: LSHC H,-6 ; low digit not numeric JUMPN H,QLOOK8 ; no numeric digits at all ("bin", maybe?) JUMPL J,QLOK5B ; if looking for greatest, let this be least MOVNI H,1 ; greatest if looking for least JRST QLOK5B ; comparison insts. QLKI1: CAME B,UNFN2(K) CAME A,UNFN1(K) UNFN2(K) ; ================================================================ ; read and parse and sort the m.f.d. ; ================================================================ RDMFD: CAMN A,LCLITS MOVSI A,(SIXBIT /DSK/) MOVEM A,DISK .CALL [SETZ SIXBIT /OPEN/ [6,,IC] DISK ; device for all "DSK" opens [SIXBIT /M.F.D./] [SIXBIT /(FILE)/] SETZB ERROPN+2 ] JRST ITSDED ; here read in however you can MOVE A,[-2000,,MFDBUF] .IOT IC,A .CLOSE IC, AOS (P) POPJ P, ; put an error message into commnd buffer EXPLAI: .OPEN IC,ERROPN POPJ P, PUSH P,A PUSH P,B MOVE A,[440700,,COMMND] ERRLUP: .IOT IC,B CAIGE B,40 SETZ B, IDPB B,A JUMPE B,ERREND JRST ERRLUP ERREND: OASC COMMND POP P,B POP P,A POPJ P, ITSDED: OASCR [0] OSIX DISK OASC [ASCIZ /: == CAN'T READ MFD == /] PUSHJ P,EXPLAI OASCR [0] POPJ P, ; :COMPAR comes here ; read in new mfd COMRMF: MOVSI A,(SIXBIT /DSK/) PUSHJ P,GETMFD JRST DEATH SETZM CMPLOS' MOVE A,[.BII,,MFDBI] .CALL CMPMFD JRST [SETOM CMPLOS JRST COMWRT] MOVE A,[-2000,,BUFFER] .IOT MFDBI,A .CLOSE MFDBI, JUMPL A,DEATH ; write out new mfd SKIPN COMMND JRST CMPCMP COMWRT: MOVE A,[.BIO,,MFDBI] .CALL CMPMFD JRST DEATH MOVE A,[-1,,MFDSAV] .IOT MFDBI,A MOVE A,[-1777,,MFDVCT] .IOT MFDBI,A .CLOSE MFDBI, SKIPE CMPLOS JRST DEATH ; now for actual compare -- this is brute force (mothers, shield your children) CMPCMP: HRRI A,BUFFER+1 HRRM A,BUFFER MOVE D,BUFFER ; old ptr CMPNXT: MOVE C,MFDSAV ; new ptr NXTOLD: MOVE A,(D) NXTNEW: CAME A,(C) ; same? JRST CMPDIF SETZM (C) SETZM (D) AOBJN D,NXTOLD JRST CMPDON CMPDIF: AOBJN C,NXTNEW AOBJN D,CMPNXT CMPDON: SETZ D, MOVE C,BUFFER CMPPLP: SKIPN A,(C) JRST CMPPNX SKIPN D OASCR [ASCIZ / Old directories that have disappeared:/] SETO D, OASC [ASCIZ / /] OSIX A OASCR [0] CMPPNX: AOBJN C,CMPPLP SETZ D, MOVE C,MFDSAV CMPQLP: SKIPN A,(C) JRST CMPQNX SKIPN D OASCR [ASCIZ / New directories that have appeared:/] SETO D, OASC [ASCIZ / /] OSIX A OASCR [0] CMPQNX: AOBJN C,CMPQLP JRST DEATH CMPMFD: SETZ SIXBIT /OPEN/ A [SIXBIT /DSK/] [SIXBIT /M.F.D./] [SIXBIT /(SAVE)/] [SIXBIT /SYS/] SETZB LSTERR CMPONE: SIXBIT /DSK .FILE.(DIR) SYSTEM/ 0 ? 0 ? 0 CMPTWO: SIXBIT /DSK .FILE.(DIR) SYSTEM/ 0 ? 0 ? 0 ; here to compare two directories COMPAR: MOVEI A,CMPONE MOVE C,[SKIPA] PUSHJ P,SEARCH JRST CDLOS1 JRST CDLOS1 ; save directory and file vector MOVE A,[DIRBUF,,MFDBUF] BLT A,MFDBUF+1777 MOVE A,[DIRVCT,,MFDVCT] BLT A,MFDVCT+200. ; update file vector HRRI DIR,MFDVCT MOVEM DIR,DIRSAV' JUMPGE DIR,CMPAGN CMPMOV: MOVE A,(DIR) SUBI A,DIRBUF ADDI A,MFDBUF MOVEM A,(DIR) AOBJN DIR,CMPMOV CMPAGN: MOVEI A,CMPTWO MOVE C,[SKIPA] PUSHJ P,SEARCH JRST CDLOS2 JRST CDLOS2 ; perform comparison MOVE ALT,DIRSAV ; ALT/ dir1, DIR/ dir2 CMPLUP: JUMPGE ALT,CMPDIR JUMPGE DIR,CMPALT MOVE C,(ALT) TLNN C,%MATCH+%NATCH JRST CMPANX MOVE D,(DIR) TLNN D,%MATCH+%NATCH JRST CMPDNX MOVE A,UNFN1(C) TLZ A,400000 MOVE B,UNFN1(D) TLZ B,400000 CAMN A,B JRST CMPSAM ; name1 is same CAML A,B ; name1:a is less JRST CMPOLD ; file is in "new" directory but not "old" CMPNEW: OASC [ASCIZ /N /] CMPNE1: MOVEI A,MFDBUF MOVEM A,THEDIR MOVE A,C PUSHJ P,LFPRN1 CMPANX: AOBJN ALT,CMPLUP JRST CMPLUP CMPOLD: OASC [ASCIZ / O /] MOVEI A,DIRBUF MOVEM A,THEDIR MOVE A,D PUSHJ P,LFPRN1 CMPDNX: AOBJN DIR,CMPLUP JRST CMPLUP CMPALT: JUMPGE ALT,DEATH MOVEI A,MFDBUF MOVEM A,THEDIR MOVE A,(ALT) TLNN A,%MATCH+%NATCH JRST CMPALX OASC [ASCIZ /N /] PUSHJ P,LFPRN1 CMPALX: AOBJN ALT,CMPALT+1 JRST DEATH CMPDIR: JUMPGE DIR,DEATH MOVEI A,DIRBUF MOVEM A,THEDIR MOVE A,(DIR) TLNN A,%MATCH+%NATCH JRST CMPDIX OASC [ASCIZ / O /] PUSHJ P,LFPRN1 CMPDIX: AOBJN DIR,CMPDIR+1 JRST DEATH ; name1 same, check name2 CMPSAM: MOVE A,UNFN2(C) TLZ A,400000 MOVE B,UNFN2(D) TLZ B,400000 CAMN A,B JRST CMPNAM CAML A,B JRST CMPOLD JRST CMPNEW ; here names are the same CMPNAM: MOVE A,UNDATE(C) AND A,[177777,,-1] ; two unused bits at left of word MOVE B,UNDATE(D) AND B,[177777,,-1] ; two unused bits at left of word CAME A,B JRST CMPSIM MOVE A,UNREF(C) ANDI A,777 ; ignore all but byte size (ref date, author) MOVE B,UNREF(D) ANDI B,777 ; ignore all but byte size (ref date, author) CAME A,B JRST CMPSIM MOVE A,UNRNDM(C) AND A,[177703,,0] ; ignore all but word count, link, reap bits MOVE B,UNRNDM(D) AND B,[177703,,0] ; ignore all but word count, link, reap bits CAME A,B JRST CMPSIM ; compare file linked to if link TLNN A,UNLINK ; are they links? JRST CMPLNG MOVEI A,MFDBUF MOVEM A,THEDIR MOVE A,C PUSHJ P,LNKFIL MOVE E,LNKBUF MOVE F,LNKBUF+1 MOVE G,LNKBUF+2 MOVEI A,DIRBUF MOVEM A,THEDIR MOVE A,D PUSHJ P,LNKFIL CAMN E,LNKBUF CAME F,LNKBUF+1 JRST CMPSIM CAME G,LNKBUF+2 JRST CMPSIM JRST CMPEQU ; compare length CMPLNG: MOVEI A,MFDBUF MOVEM A,THEDIR MOVE A,C PUSHJ P,FILLEN MOVE B,K MOVEI A,DIRBUF MOVEM A,THEDIR MOVE A,D PUSHJ P,FILLEN CAME K,B JRST CMPSIM ; files are identical CMPEQU: OASC [ASCIZ / = /] AOBJN DIR,.+1 JRST CMPNE1 ; files have same name but are otherwise different CMPSIM: OASC [ASCIZ / C /] AOBJN DIR,.+1 JRST CMPNE1 ; loss, couldn't read one of directories CDLOS1: MOVEI A,FONE SKIPA CDLOS2: MOVEI A,FTWO PUSHJ P,FILBLK OASC [ASCIZ /, == OPEN FAILED == : /] PUSHJ P,EXPLAI OASCR [0] JRST DEATH FILBLK: OSIX (A) OASCI ": OSIX 3(A) OASCI "; OSIX 1(A) OASCI " OSIX 2(A) POPJ P, CDIR1: SETZ SIXBIT /OPEN/ [6,,DSKBI] FONE FONE+1 FONE+2 FONE+3 SETZB LSTERR CDIR2: SETZ SIXBIT /OPEN/ [6,,DSKBI] FTWO FTWO+1 FTWO+2 FTWO+3 SETZB LSTERR GETMFD: PUSH P,A PUSH P,B PUSH P,C PUSH P,D SETZM MFDSAV ; need mfd for authorage on some machines (ie: DM) ; if other machines start using author stuff extensively ; then add them here ; cares about authors only if running on a machine that has them ; (ie: DM) SKIPN AUTFLG' ; -1 if search involves authorage JRST GETMFF MOVE LCLITS IFN 0,[ ; All (!) machines have file authors these days 12/83. CAME [SIXBIT /DM/] JRST GETMFQ ];TNEMMOC GETMFF: CAME A,[SIXBIT /DM/] ; dm uses authorage a lot CAMN A,[SIXBIT /DSK/] ; and MFD on local site is cheap JRST GETMF1 ; check if we need mfd -- any stars in names? GETMFQ: MOVEI B,MFDVCT MOVE C,DPSAVE MOVNI D,1 MFDSTR: CAME D,1(C) JRST GETMF1 ; stars -- we need mfd, i guess MOVE (C) MOVEM (B) AOBJN B,.+1 ADDI C,1 AOBJN C,MFDSTR ; don't need to read in MFD here MOVEI C,1(B) SETZM (C) HRLI C,1(C) MOVSS C BLT C,MFDVCT+499. CAMN A,LCLITS MOVSI A,(SIXBIT /DSK/) MOVEM A,DISK JRST MFDPNT ; read in mfd GETMF1: SETZM MFDVCT MOVE B,[MFDVCT,,MFDVCT+1] BLT B,MFDVCT+499. PUSHJ P,RDMFD JRST MFDXIT ; set for loop through MFD MOVE A,MFDBUF+1 ADDI A,MFDBUF MOVEI B,MFDVCT MFDLUP: MOVE C,DPSAVE SKIPN (A) JRST MFDNXT JUMPGE C,MFDWIN MFDTST: MOVE 0,(A) AND 0,1(C) CAMN 0,(C) JRST MFDWIN ADDI C,1 AOBJN C,MFDTST JRST MFDNXT MFDWIN: MOVE 0,(A) MOVEM 0,(B) AOBJP B,.+1 MFDNXT: ADDI A,2 CAIGE A,MFDBUF+1777 JRST MFDLUP MFDPNT: HLRZS B MOVNS B HRLS B HRRI B,MFDVCT MOVE A,B MOVEM A,MFDSAV ; now sort stupid thing SRTLUP: MOVE C,(A) MOVE D,A SRTLU1: CAMG C,(D) JRST SRTNXT EXCH C,(D) MOVEM C,(A) SRTNXT: AOBJN D,SRTLU1 AOBJN A,SRTLUP MOVE DP,MFDSAV AOS -4(P) MFDXIT: POP P,D POP P,C POP P,B POP P,A POPJ P, ; ================================================================ ; read and parse a u.f.d. ; ================================================================ ; here to open and read a regular ufd ; A/ ,, .---> X/ dev ; / nm1 ; / nm2 ; / snm ; C/ directory fixup instruction ; skip return if directory was there ; reads directory into DIRBUF GETDIR: MOVE B,3(A) .SUSET [.SSNAM,,B] ; make sname follow what we do .CALL [SETZ SIXBIT /OPEN/ [16,,IC] ; don't snuff ref date (A) 1(A) 2(A) 3(A) SETZB A] JRST GETERR SETZ DIR, MOVE A,[-2000,,DIRBUF] .IOT IC,A .CLOSE IC, XCT C ; fix up arc dirs SKIPA ; if archive isn't, skip once AOS (P) ; normally skip twice AOS (P) POPJ P, ; don't skip, means got real error GETERR: POPJ P, ; eventually win ; when remote ITS down? ; archives have their 11 header words displaced by one word ; and so they have to be fixed up before they can be treated ; like regular directories ARCFIX: MOVE A,DIRBUF CAMN A,[SIXBIT /ARC1!!/] JRST ARCOK ; newest style, thanx to RMS CAME A,[-1] CAMN A,[SIXBIT /ARC!!!/] ; new style, thanx to MARC SKIPA POPJ P, MOVE A,[DIRBUF+1,,DIRBUF] BLT A,DIRBUF+9. ARCOK: AOS (P) POPJ P, ; parse a directory ; returns aobjn pointer in DIR and ALT to file blocks PRSDIR: PUSH P,A PUSH P,B SETZM DIRVCT MOVE B,[DIRVCT,,DIRVCT+1] BLT B,DIRVCT+199. MOVE ALT,[-200.,,DIRVCT] MOVE B,DIRBUF+UDNAMP ; offset of name area ADDI B,DIRBUF-LUNBLK ; start of dirbuf NXTNAM: ADDI B,LUNBLK CAIL B,DIRBUF+2000 JRST GETXIT SKIPN (B) JRST NXTNAM MOVEM B,(ALT) AOBJN ALT,NXTNAM GETXIT: HLRE A,ALT MOVNS A SUBI A,200. HRL ALT,A HRRI ALT,DIRVCT PUSHJ P,ATOP POP P,B POP P,A POPJ P, ; ================================================================ ; syntax error in command line ; ================================================================ SYNERR: OASC [ASCIZ /Can't understand: /] MOVE B,[440700,,COMMND] SYNER1: CAMN B,COMPTR JRST SYNRST SYNER2: ILDB A,B JUMPE A,EXIT PUSHJ P,IOTA JRST SYNER1 SYNRST: OASCI "| JRST SYNER2 ; ================================================================ ; interrupt handler (tty only) ; ================================================================ ZZZ=. LOC 42 JSR TSINT LOC ZZZ TSINT: 0 0 PUSH P,A PUSH P,B SKIPG A,TSINT JRST TSINTM MOVEI A,TYIC .ITYIC A, JRST TSDIS .RESET TYIC, ; reset channel CAIN A,^G JRST TSKILL ; if ^S or ^G typed, quit CAIN A,^S JRST TSSTOP SKIPA TSDISX: MOVEM A,TSINT+1 TSDIS: POP P,B POP P,A .DISMIS TSINT+1 TSSTOP: SKIPN INPRT MOVEI A,SUMINT ; normal ^S causes end SKIPGE INPRT MOVEI A,PRTFLS ; with printing, terminates one file SKIPLE INPRT MOVEI A,PRTFL1 JRST TSDISX ; here we got a ^G, which always means kill TSKILL: MOVEI A,EXIT JRST TSDISX TSINTM: SKIPE MORLOK JRST TSDIS ; dismiss more immediately if in --next file-- .RESET TYIC, TRNN A,1_TYOC ; more only on output channel JRST TSDIS ; spurious interrupt? MOVE A,[440700,,[ASCIZ /--More--/]] MOVEI B,8 PUSHJ P,MESIOT .CALL [SETZ SIXBIT /IOT/ MOVEI TYIC A MOVSI %TIPEK+%TIACT SETZB LSTERR] .VALUE CAIN A,^G ; ^G is always kill JRST TSKILL CAIE A,^S ; ^S is also stop CAIN A,177 ; not rubout is continue JRST TSMSTF ; rubout or ^S is stop and flush character CAIE A,40 ; space is continue JRST TSMSTP .CALL FLSCHR ; and flush character .VALUE .IOT TYOC,[^M] .IOT TYOC,[^J] JRST TSDIS FLSCHR: SETZ ; flush the space SIXBIT /IOT/ MOVEI TYIC A MOVSI %TIACT SETZB LSTERR TSMSTF: .CALL FLSCHR ; here to stop and flush character .VALUE TSMSTP: MOVE A,[440700,,[ASCIZ /Flushed/]] ; here to stop w. o. flushing char MOVEI B,7 PUSHJ P,MESIOT JRST TSSTOP MESIOT: .CALL MESCAL .VALUE .CALL [SETZ ? SIXBIT /FINISH/ ? SETZI TYOC] .VALUE POPJ P, MESCAL: SETZ SIXBIT /SIOT/ MOVEI TYOC A B SETZB LSTERR ; ====================================================================== ; Brief typeout routine ; ====================================================================== BPrint: Aos K,BCount ;This is the BCount'th U/J pair (>>) Cail K,6 Jrst [Movei K,1 Movem K,BCount OAscr [0] Jrst .+1] Caie K,1 OAsci ^I OAsci " ; OSix UNFN1(M) OAsci ^I OSix UNFN2(M) Popj P, ; ================================================================ ; uuo handler (typeout uuos) ; ================================================================ ZZZ==. LOC 40 0 JSR UUOH LOC ZZZ UUOCT==0 UUOTAB: JRST ILUUO IRPS X,,[DEC BPTR OCT CTLP ASCC SIX ASC ASCI ASCR SIXS HPOS ALIGN SIGN] UUOCT==UUOCT+1 O!X=UUOCT_27. JRST UO!X TERMIN IFG UUOCT-37, PRINTC /---TOO MANY UUO'S---/ UUOMAX==.-UUOTAB UUOD: 0 ; contents of UUO eff addr. UUOE: 0 ; UUO effad. 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 ILUUO: .VALUE [ASCIZ /:ILLEGAL UUO/] 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 SKIPE A,C ; get saved cr? 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 SKIPG B MOVEI B,1 ; always at least one space UOHPO1: MOVEI A,40 PUSHJ P,IOTA SOJG B,UOHPO1 JRST UUORET POWER: 0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000. UOSIGN: MOVM D,UUOD ANDI A,7 MOVE A,POWER-1(A) MOVEI C,40 UOSIG1: CAMLE A,D PUSHJ P,IOTC IDIVI A,10. CAIE A,1 JRST UOSIG1 MOVEI A,"+ SKIPGE UUOD MOVEI A,"- SKIPN UUOD MOVEI A," PUSHJ P,IOTA SETZ A, JRST UODEC 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 POP P,A POPJ P, HPOS: 0 ; line pos IOTA: CAIN A,^P JRST [.IOT TYOC,["^] ADDI A,100 JRST IOTA1] CAIN A,^J POPJ P, IOTA1: .IOT TYOC,A CAIE A,^M JRST IOTTAB .IOT TYOC,[^J] SETZM HPOS POPJ P, ; update line pos IOTTAB: CAIN A,^I JRST [MOVE A,HPOS ADDI A,10 ANDI A,7770 MOVEM A,HPOS POPJ P,] AOS HPOS POPJ P, GETRSR: PUSH P,B MOVE B,[SQUOZE 0,NQS] .EVAL B, .VALUE [ASCIZ /:.EVAL OF NQS FAILED/] MOVNS B HRLS B HRRI B,TRESRV MOVEM B,QPTR MOVE A,[SQUOZE 0,QRESRV] PUSHJ P,GETQ MOVE B,QPTR HRRI B,TPKID MOVE A,[SQUOZE 0,QPKID] PUSHJ P,GETQ POP P,B POPJ P, GETQ: .EVAL A, .VALUE [ASCIZ /:.EVAL OF SYMBOL IN A FAILED/] HRLS A HRR A,B .GETLOC A, ADD A,[1,,1] AOBJN B,.-2 POPJ P, END START