From 468cb5eda197a8eec603344c833409455c4b4352 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Wed, 2 Nov 2016 13:04:30 +0100 Subject: [PATCH] DUMP source code. --- src/syseng/dump.442 | 8736 +++++++++++++++++++++++++++++++++++++++++ src/sysnet/netwrk.266 | 2705 +++++++++++++ 2 files changed, 11441 insertions(+) create mode 100755 src/syseng/dump.442 create mode 100755 src/sysnet/netwrk.266 diff --git a/src/syseng/dump.442 b/src/syseng/dump.442 new file mode 100755 index 00000000..4575efaa --- /dev/null +++ b/src/syseng/dump.442 @@ -0,0 +1,8736 @@ +;-*- Mode:MIDAS -*- + +TITLE DUMPER + +.SYMTAB 11657.,5000. ;be-bip be-beh + +SUBTTL AC, DIRECTORY DEFINITIONS + +ZR=0 +A=1 +B=2 +C=3 +D=4 +E=5 +N=6 + +SYM=7 +TER=10 +RTAPE"T=SYM +RTAPE"TT=TER +NETWRK"T=SYM +NETWRK"TT=TER + +U=11 +V=12 +W=13 +X=14 +USRUFD=15 +P=17 + +IF1,[ +PRINTX /WHICH MACHINE? / +.TTYMAC A +.TTYFLG==.TTYFLG+1 +PRINTX/A +/ +.TTYFLG==.TTYFLG-1 + +;When using this macro, also check the WRONG flag if you really care +DEFINE MCOND B +,TERMIN +MCHN==SIXBIT/A/ +TERMIN +] + +NEWCOD==1 ; Assume a KS unless otherwise informed +IFE MCOND MX, NEWCOD==0 ;Use old code on MX KL only (running old ITS) + +DEFINE SYSCAL OP,ARGS + .CALL [SETZ ? SIXBIT/OP/ ? ARGS ((SETZ))] +TERMIN + + + ;GET DEFINITION OF SYMBOLS FOR DIRECTORY FORMAT +.INSRT SYSENG;FSDEFS > + + ;THESE PARAMETERS CONTROL THE 'SYSENG; MACRO TAPES' FILE. +;DON'T CHANGE THESE IF YOU'RE NOT RJL +;AND EVEN THEN YOU SHOULD BE CAREFUL +MAXTAP==3000. ;MAXIMUM TAPE NUMBER +1 +IFE MCOND AI, MAXTAP==4000. ;EVEN THOUGH I'M NOT RJL +IFE MCOND MX, MAXTAP==5000. ; I'm not RJL either... -Alan +TPINFL==10. ;NUMBER OF WORDS OF INFO PER TAPE + SUBTTL I/O CHANNEL, UUO DEFINITIONS + +MFDCH==1 ;MASTER FILE DIRECTORY INPUT +UFDCH==2 ;FILE DIRECTORY INPUT +DSKIN==3 ;DISK INPUT +MAGOUT==4 ;MAG TAPE OUTPUT +TYIC==5 ;TTY INPUT +TYOC==6 ;TTY OUTPUT +DSKOUT==7 ;DISK OUTPUT +MAGIN==10 ;MAG TAPE INPUT +LPTCH==11 ;LPT OR TPL OUTPUT +ERRC==12 ;ERR DEVICE INPUT +STATC==13 ;TAPE STATUS STORED ON DISK +SAVET==14 ;SAVED TAPE FILE NAMES +SNPLCH==15 .SEE SNPLACE + +RTAPE"RSICH==16 +RTAPE"RSOCH==17 + +LPDL==100 ;LENGTH OF PDL +LPAT==1000 ;LENGTH OF PATCH AREA + +BUFSIZ==5 +PAGSIZ==2000 + +RPCNT==0 +UUOTAB: ;THIS TABLE GENERATED BY FOLLOWING IRP +IRP X,,[PSIS,PDPT,POCT,PERR,PASC,SIXTYP,OPEN] +RPCNT==RPCNT+1 +IRPS Y,,X +Y=RPCNT_33 +.ISTOP +TERMIN +LOC UUOTAB+RPCNT-1 +A!X +TERMIN +LUUOTB==RPCNT +IFG LUUOTB-37,.ERR TOO MANY UUOS DEFINED + +;PRINT A FIXED STRING ON LPT (IF LPTSW) OR ON TTY +DEFINE PRINT ARG + PASC [ASCIZ \ARG\] +TERMIN + +;PRINT A STRING THEN ERR OUT +DEFINE DIE ARG + PERR [ASCIZ /ARG/] +TERMIN + +;PRINT SOME FILE NAMES +DEFINE PRTFNS + PRINT _ + PSIS SNAME + PRINT [;] + PSIS FN1 + PSIS FN2 +TERMIN + + SUBTTL MISCELLANEOUS VARIABLES + +ZZ==. +LOC 41 + JSR UUOH + JSR INT +LOC ZZ +TYIPD: 0 ;DEPTH IN IO-PUSHES ON TYIC +DISPLY: 0 ;0 => HARD COPY, 1 => SCREEN +PRNAM1: .FNAM1 ;PROGRAM NAME +PRNAM2: .FNAM2 ;PROGRAM VERSION NUMBER +WRONG: 1 ;0 => ON RIGHT MACHINE, -1 => ON WRONG MACHINE +GARBAG: 0 ;READ INTO HERE TO IGNORE +ERRPDP: 0 ;PDL LEVEL AT ADMP4 +CTRLG: 0 ;0 NORMAL, -1 DEFER CONTROL-G, +1 DEFERRED CONTROL-G PENDING +MYNAME: 0 ;ORIGINAL SNAME +USNM: SIXBIT /FIRST/ ;CURRENT SNAME +LUSNM: 0 ;LAST USER NAME DUMP COMPLETED FOR +FUSNM: 0 ;FIRST USER NAME ON TAPE +RFDATE: 0 ;REFERENCE DATE +UNRNDW: 0 ;UNRNDM WORD FROM RRDATE SYSTEM CALL +NTAPES: -1 ;NUMBER OF REEL IN CURRENT DUMP, -1==> WE DON'T KNOW THIS PARAMETER +FDATE: 0 ;CREATION DATE OF FILE +AUTHOR: 0 ;AUTHOR OF FILE +BLOCKS: 0 ;BLOCKS IN UDIR +QUOTA: 0 ;QUOTA OF UDIR +OFINDF: 0 ;-1 IF DOING AN OFIND, 0 OTHERWISE +TEST1: TDNN B,(A) ;SORT TEST 1 +TEST2: TDNE B,(C) ;SORT TEST 2 +UFDDAT: -1 ;DATE OF UFD INPUT +MFDDAT: -1 ;DATE OF MFD INPUT +DMPMFD: 0 ;DUMP MFD IF -1 +DMPUFD: 0 ;DUMP UFD IF -1 +DMPDIR: 0 ;OR OF DMPUFD AND DMPMFD +DMPLNK: 0 ;-1 => DUMP LINKS +RELOSW: 0 ;-1 IF DOING A RELOAD + ;CAUSES DUMPBIT, REAPBIT, AUTHOR, AND REFDATE OF LOADED + ; FILE TO BE RESTORED FROM TAPE COPY OF UFD. ALSO, + ; CAUSES TAPE UFDS TO BE READ, LINKS TO BE RESTORED, + ; DUMPBIT, REAPBIT, AUTHOR, REFDATE TO BE RESTORED, + ; AND CAUSES OLD FILES ON DISK BUT NOT ON TAPE-UFD + ; TO BE DELETE, THUS RESTORING THE FILE SYSTEM COMPLETELY. +PDIRSW: 0 ;-1 => PRINT DIRECTORY FROM TAP AT MAGOP1. +MRGSW: 0 ;-1 => MERGE (I.E. NEVER LOAD OVER ANY EXISTING FILE) + ;0 => BASE ON VARIOUS OTHER CRITERIA. +CAREF: 0 ;-1 DONT OVERWRITE FILES WHICH HAVEN'T BEEN DUMPED +LOSRSW: 0 ;-1 SORRY MODE, ALWAYS WRITE OVER EXISTING COPIES IN LOAD + ;0 => DON'T WRITE OVER FILES WITH NEWER DATE. (ASK FIRST) +NOASK: 0 ;-1 => DON'T ASK QUESTIONS +APPENF: -1 ;-1 => NO FILES DUMPED FOR CURRENT USER YET +LDPACK: -1 ;NON-NEGATIVE => PACK# OF SINGLE PACK BEING RELOADED, IGNORE + ;FILES ON OTHER PACKS, DELETE NEW FILES ON THIS PACK SINCE + .SEE DIRUPN ;NOT REALLY THERE (SEE DIRUPN) + .SEE DIRU2 ;ALSO + ;IF YOU USE THE LDPACK FEATURE, USE THE 'RELOAD L SORRY' + ; COMMAND OR YOU WILL BE SORRY. +BBPACK: -1 ;LIKE LDPACK, BUT DOESNT MUNGE DISK DIRECTORIES BECUZ WE ASSUME + ;THEY ARE CORRECT. DOESNT DELETE ANYTHING. +DEADPK: -1 ;Non-negative => Number of pack lost in head crash that + ; left the rest of the filesystem OK. Files referenced on + ; this pack from existing UFD's need to be restored. +CRDIR: 0 ;-1 TO CREATE DIRECTORIES WHEN LOADING FILES FROM TAPE +FILN: 0 ;FILE NUMBER IN FIND (I.E. SEQUENCE NUMBER ON TAPE) +FLNI: -1 ;-1 FIRST TIME THRU FNG (NEED TO OPEN FILE DIRECTORY) + ;SETOM THIS WHEN CHANGING THE SNAME. +GFRFQ: -1 ;FIRST TIME FLAG FOR QUOTA PRINTOUT +FCDMAP: 0 ;-1 => MEANS WE HAVE MAPPED IN CORE PAGES FOR BUFFER + .SEE FCDMP +MFDIN: -1 ;-1 FIRST TIME THRU M.F.D. (NEED TO OPEN M.F.D.) +ITAPE: -1 ;-1 IF JUST REWOUND (NEED TO READ/WRITE TAPE-HEADER) +TAPTYP: 0 ;1 LOCAL, -1 REMOTE, -2 REMOTE AND MOUNTED, 0 NOT DECIDED YET +TAPHST: BLOCK 2 ;ASCIZ HOST FOR REMOTE TAPE +TAPDRV: BLOCK 2 ;ASCIZ DRIVE NAME +TAPDIR: BLOCK 2 ;ASCIZ READ, WRITE, OR BOTH +RMTUSR: BLOCK 2 ;ASCIZ REMOTE USER NAME +RMTPSW: BLOCK 2 ;ASCIZ REMOTE PASSWORD +TAPEF: 0 ;HOLDS TAPE STATUS (IFN NEWCOD,[ .STATUS ] .ELSE CONI 344,) +IFE NEWCOD,[ + TF%BOT==100000 ;BEGINNING OF TAPE + TF%EOT==4000 ;PHYSICAL END OF TAPE + TF%EOF==10000 ;END OF FILE SEEN + TF%RDY==40 ;DRIVE ONLINE AND NOT BUSY +];IFE NEWCOD +IFN NEWCOD,[ + TF%BOT==4000 ;BEGINNING OF TAPE + TF%EOT==10000 ;PHYSICAL END OF TAPE + TF%EOF==200000 ;END OF FILE SEEN +;--- This is wrong, JTW seems to have misunderstood this bit in the old code +;--- really need a drive on-line indication +;--- but OPEN returns an error if it's not on-line + TF%RDY==100000 ;DRIVE ONLINE AND NOT BUSY +];IFN NEWCOD +LFDIR: 0 ; STORAGE FOR LAST FILE POINTER (IN FIND) +TFIL: BLOCK LUNBLK ; TEMPORARY STORAGE FOR FILE SORT IN FIND + +MTCMD: 0 ;STORAGE FOR .MTAPE +MAGOPN: 0 ; 0=> MAGOUT NOT OPEN,-1=> OPEN +GTSYNF: 0 ; GETSYL NEGITIVE FLAG +GTSYCC: 0 ;GETSYL NUMBER OF CHARACTERS +LNKFLG: 0 ;-1=>DUMPING OR LOADING A LINK +DMPMOD: 0 ;-1 DUMPING, 0 RETRIEVING +TCOPYF: 0 ;-1 => COPYING TAPES +OTAPE: 0 ;OUTPUT VERSION OF ITAPE, IN TCOPY +DPACK: 0 ;PACK TO DUMP OR -1 IF ALL +INCREM: 0 ;-1 DUMP INCREMENTAL, 0 ALL FILES +FULLDMP:0 ;-1 FULL DUMP, 0 SPECIFIC FILES +MICFLG: 0 ;-1 MICROTAPE, 0 DISK [NOTHING SETS THIS] ******* +LPTSW: 0 ;-1 LPT OR TPL OUTPUT ON, 0 OUTPUTTING TO TTY +EOTFLG: 0 ;-1 WHEN HIT EOT ON READ, RESET BY REWIND [NOTHING LOOKS AT THIS] ******* +EXPERM: 0 ;-1 WHEN ONLY EXPERIMENTING => .DMPCH NOT SET, BYPASS LCHECK +CKIDMP: 0 ;0=> CHECK INCREMENTAL DUMPS (SET TO -1 BY 'NO' OPTION) +REAPSW: 0 ;-1 IF A REAP TO BE DONE AFTER DUMP +NFTDMP: 0 ;NUMBER OF FILES THIS DUMP OR THIS TAPE, WHICHEVER IS SMALLER. +CDMFL: 0 ;-1 CONTINUE A FULL DUMP FROM GIVEN USER, 0 ORDINARY DUMP +LSTWHL: 0 ;-1 LIST WHILE DOING DUMP OR LOAD +CHKFLG: 0 ;-1 CHECK OPERATION, 0 DUMP/LOAD +DECIDF: 0 ;-1 DECIDE WHICH TAPES TO USE [NOTHING LOOKS AT THIS] ******* +DATEF: 0 ;-1 DUMP ONLY FILES WITH CREATION DATES GREATER THAN OR EQUAL TO DATE +DATESF: 0 ;-1 DUMP ONLY FILES BETWEEN TWO DATES +DATE: 0 ;STORAGE FOR ABOVE +DATE1: 0 ;STORAGE FOR UPPER BOUND IF THERE IS ONE +ARCHVF: 0 ;-1 CALL THIS AN ARCHIVE +DEVICE: 0 ;DEVICE IF SPECIFIED [THIS IS NEVER USED] ******* +SUPERC: 0 ;-1 TO SUPPRESS DATA ERROR MESSAGES (USED BY CHECK) +BASE: 10. ;OUTPUT BASE IN DPT/DOT ROUTINE +FLENTH: 0 ;FILE LENGTH +RDERR: 0 ;-1 => READ DATA ERROR OCCURRED +PHYEOT: 0 ;-1 => PHYSICAL END OF TAPE +;TABLE OF "SECONDARY" DISKS. +;THESE ARE THE SAME AS IN ITS +NQS==10 +QPKID: BLOCK NQS ;PACK NUMBER +QRESRV: BLOCK NQS ;PACK NAME OR RESERVED FLAG + +;BIT MASK FOR THE PACK NUMBERS OF SECONDARY DISKS +SECMSK: 0 ;SET UP AT SETSCM +PRIMSK: 0 ;THE PRIMARY DISKS + +;WORDS USED BY CHECKER +ERRCNT: 0 ;ERRORS ENCOUNTERED THIS FILE ON TAPE IN +ERRDSK: 0 ;ERRORS ENCOUNTERED THIS FILE IN DISK IN +PNTALL: 0 ;-1 TO PRINT ALL FILES AS THEY GO +ERRALL: 0 ;SET IF ANY ERRORS HAPPENED +NEWCHR: 0 ;DUMP CHARACTER FOR THIS FILE +WRDONG: 0 ;COUNT OF BAD WORDS +LNTCNT: 0 ;DIFFERENCE IN LENGTH OF TWO FILES +ALLWRD: 0 ;TOTAL WORDS ON THIS REEL SO-FAR + +LENGTH: 0 ;NUMBER OF FILE SPECS TYPED IN BY USER AND NOT + ; SATISFIED YET. ALSO LENGTH OF TAPE FILE IN FNDCON. +EOFF: 0 ;EOF FLAG FOR TAPE FILES ON DISK. USED IN AFIND COMMAND +DIRIDX: 0 ;POINTER TO FILE DIRECTORY BUFFER(FDIRBF) +BARROW: 0 ;BACK-ARROW FLAG +ACLODF: 0 ;-1 => GOT TO EXECU VIA ACLOAD, DON'T ASK FOR FILES +TTYST1: 0 ;TTY VARS +TTYST2: 0 +TTYSTS: 0 +DKMFDP: 0 .SEE DKAUTH ; -1 If DSKMFD is in +DKUFDP: 0 .SEE DKLOOK ; SIXBIT of DSKUFD currently in +DKBLK: 0 .SEE DKBLKF ; Saved name block pointer for DKBLKF + +LLIST==200. ;NUMBER OF FILE SPECS ALLOWED +IRP Y,,[TO,FM] +IRP X,,[DEV,SNM,FN1,FN2] +Y!!X: BLOCK LLIST +TERMIN +TERMIN + +FMDUMP: BLOCK LLIST ;-1 => THIS SPEC SATISFIED AT LEAST ONCE. + +IRP X,,[DEV,SNM,FN1,FN2] +TIN!X: 0 ;HOLDS SPECS FOR FILGET +TERMIN + +IRP X,,[DEV,SNM,FN1,FN2] +TYN!X: 0 ;HOLDS SPECS FOR FILGET +TERMIN + +DAYTIM: 0 ;HOLDS CREATION DATE AND TIME OF FILE DURING FIND COMMAND +PSNAM: 0 ;SNAME TO BE PRINTED BY FIND COMMAND +PFF1: 0 ;FILE NAME TO BE PRINTED BY FIND COMMAND +PFF2: 0 ;.. +WRDCNT: 0 ;COUNT OF WORDS IN FILE +SAVAOB: 0 ;AOB OF FIRST BAD WORD + +INTAC: BLOCK 20 ;SAVED ACS DURING INTERRUPT + +GREATF: -1 ;0 ==> > FILE HACKED DURING DUMP + +THBLK: -LTHBLK,,0 ;TAPE-HEADER-BLOCK +THTPN: -1 ;TAPE NUMBER,,NUMBER OF REEL IN THIS DUMP, -1==> WE DON'T YET KNOW THIS PARAMETER +THDATE: 0 ;TAPE CREATION DATE (SIXBIT) +THTYPE: 0 ;0 RANDOM, >0 FULL DUMP, <0 INCREMENTAL DUMP +LTHBLK==.-THBLK +LTHTPN: -1 ;LAST THTPN + +HBLK: -LHBLK,,0 ;FILE-HEADER-BLOCK +HSNM: 0 ;SYS NAME +HFN1: 0 ;FN1 +HFN2: 0 ;FN2 +LHBLKZ==.-HBLK ; Must be at least this long +HPKN: 0 ;LINK FLAG,,PACK NUMBER (SAME INFO AS 3RD VALUE FROM + ; FILBLK, BUT IN A DIFFERENT FORMAT) +HDATE: 0 ;CREATION DATE AND TIME OF FILE ON DISK (DISK-FORMAT) (4TH + ; VALUE FROM FILBLK) + ; Next two added 7/14/89 by Alan +HRDATE: 0 ;REFERENCE DATE, AUTHOR INDEX, BYTE SIZE AND BYTE COUNT + ; (5TH VALUE FROM FILBLK) +HLEN: 0 ;LENGTH OF FILE IN WORDS (FROM FILLEN) +LHBLK==.-HBLK ; Must not be longer than this + +HFNL: 0 + +STAPST: ;BLOCK OF DATA STORED ON DISK FOR TAPE STATUS (IN SYSENG;MACRO TAPES) +STAPEN: 0 ;TAPE NUMBER,,REEL NUMBER +STDATE: 0 ;DATE TAPE LAST WRITTEN +STYPE: 0 ;TYPE OF DATA LAST WRITTEN AS THTYPE ABOVE +SFUSNM: 0 ;FIRST USER ON THIS TAPE +SLUSNM: 0 ;LAST USER ON THIS TAPE +SUSER: 0 ;UNAME OF PERSON WHO DUMPED THIS TAPE +SDONE: 0 ;ZERO IF DUMP NOT COMPLETED,-1 REGULAR, 1 ARCHIVE + BLOCK TPINFL+.-STAPST + +INTERR: SIXBIT /DEVICE/ ;USED FOR DISK ERROR ANALYSIS + SIXBIT /RANDOM/ + SIXBIT /FILE/ + SIXBIT /LOSER/ + SUBTTL OPEN-BLOCKS, .CALL BLOCKS + +LPTO: SIXBIT / !LPT/ ;OUTPUT TO LPT (AND TPL ETC.) + SIXBIT /WALL/ + SIXBIT />/ + 0 + 0 ;LEAVE THESE HERE !!!! + +MAGI: 26,,(SIXBIT /MT0/) ; BLOCK IMAGE, DON'T FLUSH TO EOF ON CLOSE + SIXBIT /MACRO/ + SIXBIT /IN/ + 0 + 0 ;LEAVE ALONE + +MAGO: SIXBIT / 'MT0/ ;OUTPUT TO MAG-TAPE + SIXBIT /MACRO/ + SIXBIT /OUT/ + 0 + 0 + +MFO: (SIXBIT /DSK/) ;MASTER FILE DIRECTORY IN + SIXBIT /M.F.D./ + SIXBIT /(FILE)/ + 0 + 0 + +FNO: SIXBIT / &DSK/ ;FILE DIRECTORY IN + SIXBIT /.FILE./ + SIXBIT /(DIR)/ + 0 + 0 + +CRUFD: SIXBIT / DSK/ + SIXBIT /..NEW./ + SIXBIT /(UDIR)/ + +TRNI: SIXBIT / &DSK/ ;INPUT FROM DISK +FN1: 0 ;FILE NAME 1 +FN2: 0 ;FILE NAME 2 +SNAME: 0 + 0 ;HERE IN CASE OF .FDELE TRNI + +;***** ***** KEEP THESE NEXT 6 LOCATIONS TOGETHER FOR LINK INFO ***** +LNKBLK: 200000,,(SIXBIT /DSK/) + 0 + 0 +LNKNM1: 0 ; LINK FN1 +LNKNM2: 0 ;LINK FN2 +PACKN: 0 ;PACK NUMBER OR SNAME IN LINK IF LEFT HALF NON ZERO +;****** ***** ***** + +CPYO: SIXBIT / #DSK/ ;OUTPUT TO DISK +LFN1: 0 +LFN2: 0 + 0 + 0 + +ERROP: 0,,(SIXBIT/ERR/) + 1 + 0 + 0 + 0 + +SPLACE: SIXBIT /SYSENG/ ;PLACE TO STORE MACRO TAPES +STATOP: SIXBIT / DSK/ ;FILE TO SAVE TAPE DATA IN + SIXBIT /MACRO/ + SIXBIT /TAPES/ + 0 + 0 + +USRDEL: 0 ;FOR .FDELE + 0 + 0 +NPLACE: SIXBIT /.TAPE0/ ;TAPE DIRECTORY DIRECTORY, OR 0 IF HAVEN'T DECIDED YET +NSVOP: SIXBIT / 'DSK/ + SIXBIT /TAPE/ +NSVTPN: 0 + 0 ;FOR .FDELE + 0 + 0 + +TDIRN: 0 ;CURRENT INDEX IN TDIRTB + +SNBUF: BLOCK UDNAMP+1 ;USED TO GET UDNAMP TO ESTIMATE DIR FULLNESS + +SNTRY: SETZ + SIXBIT /OPEN/ + 3000,,E + MOVEI SNPLCH + [SIXBIT/DSK/] + [SIXBIT/TAPE/] + SNTRYN + SETZ TDIRTB(A) + +SNTRYN: 0 + +RUSN: 0 ;NAMES USED IN SINGLE FILE RESTORE +RFN1: 0 +RFN2: 0 + 0 + 0 + +CUSN: 0 ;CURRENT USER NAME USED WHEN LSTWHL IS ON +RDATE: SETZ + SIXBIT /RFDATE/ + [DSKIN] + SETZ FDATE(2000) + +RQDATE: SETZ + SIXBIT /RQDATE/ + SETZM HDATE + +SDATE: SETZ + SIXBIT /SFDATE/ + [DSKOUT] + SETZ FDATE + +SRDT: SETZ + SIXBIT /SRDATE/ + [DSKOUT] + SETZ RFDATE + +FILLEN: SETZ + SIXBIT /FILLEN/ + [DSKIN] + SETZM LENGTH + +FILBLK: SETZ + SIXBIT /FILBLK/ + [DSKIN] + 2000,,0 + 2000,,0 + 2000,,0 + 2000,,FDATE + SETZM RFDATE + + +SRFDAT: SETZ + SIXBIT /SRDATE/ + [DSKIN] + SETZ RFDATE + +CLBIT: SETZ + SIXBIT /SDMPBT/ + [STATC] + SETZ [0] + +RESRDT: SETZ ;RESTORE REF DATE + SIXBIT /RESRDT/ + SETZ [DSKIN] + +RRDATE: SETZ + SIXBIT /FILBLK/ + 1000,,DSKIN + 2000,,0 + 2000,,0 + 2000,,UNRNDW + 2000,,0 + 402000,,RFDATE + +CREFDT: SETZ ;COPY REF DATE INTO FDATE + SIXBIT /SFDATE/ + [DSKIN] + SETZ RFDATE + +RHDATS: SETZ + SIXBIT /FILBLK/ + MOVEI DSKIN + MOVEM 0 ; FN1 + MOVEM 0 ; FN2 + MOVEM 0 ; RND + MOVEM HDATE + SETZM HRDATE + +RHLEN: SETZ + SIXBIT /FILLEN/ + MOVEI DSKIN + SETZM HLEN + +TTYGET: SETZ + SIXBIT /TTYGET/ + MOVEI TYOC + MOVEM TTYST1 + MOVEM TTYST2 + SETZM TTYSTS + +TTYSET: SETZ + SIXBIT /TTYSET/ + MOVEI TYOC + TTYST1 + TTYST2 + SETZ TTYSTS + +TRRDFO: SETZ ;OPEN BLOCK FOR INDIRECT COMMAND FILES FROM DISK + SIXBIT /OPEN/ + 1000,,TYIC + TINDEV + TINFN1 + TINFN2 + SETZ TINSNM + SUBTTL UUO HANDLER + +UUOH: 0 + PUSH P,40 + PUSH P,UUOH ;FOR RECURSIVE UUOS + PUSH P,A + PUSH P,B + PUSH P,C + LDB C,[330600,,40] ;OP CODE + CAILE C,0 + CAILE C,LUUOTB + .VALUE ;ILLEGAL UUO + PUSHJ P,@UUOTAB-1(C) + CAIA ;REGULAR RETURN + JRST SKPRET ;SKIP RETURN + POP P,C + POP P,B + POP P,A + POP P,UUOH + POP P,40 + JRST 2,@UUOH + +SKPRET: POP P,C + POP P,B + POP P,A + POP P,UUOH + POP P,40 + AOS UUOH + JRST 2,@UUOH + +;MTAPE UUO. AC IS OPERATION, E IS SUBCOMMAND. +;THIS IS NEVER USED, TAKES THE WRONG ARGUMENTS, AND DOESN'T +;WORK SINCE IT USES THE 'MTAPE' SYMBOLIC SYSTEM CALL, +;WHICH DOES NOT EXIST!! ******* +; +;AMTAPE: PUSH P,40 ;PUSH OF 40 IS SUPERFLUOUS ******* +; OPEN MAGIN,MAGI +; JRST RET +; POP P,40 +; LDB A,[270400,,40] ; SPACE, DO SOMETHING ELSE, OR SET MODE(S) +; HRRZ B,40 ;SUBCOMMAND +; .CALL TAPBLC +; .LOSE 1000 +; POPJ P, +; +;TAPBLC: SETZ +; XWD SIXBIT / MTA/,SIXBIT / PE/ ;SO NMTAPE WILL NOT FIND THIS +; [MAGIN] +; A +; SETZ B + +;PSIS UUO. PRINT A SPACE THEN A SIX CHARACTER SIXBIT WORD. +APSIS: PUSHJ P,TYOS + +;SIXTYP UUO. PRINT A SIX CHARACTER SIXBIT WORD. +ASIXTYP:MOVE B,@40 + JRST SIXTYO + +;DPT UUO. PRINT A DECIMAL NUMBER RIGHT-JUSTIFIED IN 6 COLUMNS. +;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS! +APDPT: MOVE C,-1(P) ;PRINT DECIMAL NUMBER + MOVE A,@40 + PUSHJ P,ADJUS + JRST DPT + +ADJUS: PUSH P,A ;'FIXED' FORMAT HACK + MOVM B,A + SKIPN B + MOVEI B,1 + MOVEI C,10000. + SKIPGE A + IDIVI C,10. ;FOR THE MINUS SIGN +ADJUS1: PUSHJ P,TYOS + CAML B,C + JRST POPAJ + IMULI B,10. + JRST ADJUS1 + +;POCT UUO. PRINT SIGNED OCTAL NUMBER, PRECEDED BY SPACE. +;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS! +APOCT: MOVE C,-1(P) ;PRINT OCTAL NUMBER + PUSHJ P,TYOS + MOVE A,@40 + JRST DOT + +;PERR UUO. MAINLY FOR DIE MACRO. +APERR: SETZM LPTSW ;SURELY THESE SHOULD NOT GO INTO WALLPAPER FILE + PUSHJ P,APASC ;PRINT ASCII AND DIE + JRST ERR + +;OPEN UUO. LIKE .OPEN, BUT IF IT FAILS GIVES MESSAGE ON TTY. +AOPEN: MOVEI A,<.OPEN_-27.> + MOVE B,40 + DPB A,[331100,,B] + MOVSI C,10 ;DO NOT SET REFERENCE DATE ON DSKIN + LDB A,[270400,,B] + CAIN A,DSKIN + IORM C,@40 + SETZM A + XCT B + SETOM A + LDB B,[270400,,B] + CAIN B,DSKIN + ANDCAM C,@40 + SKIPN A + JRST POPJ1 ;SUCCEEDED + PUSH P,LPTSW + SETZM LPTSW ;TYPE ERROR MESSAGE ON TTY + PUSH P,40 + HRRZ B,UUOH + SOS B + POCT B ;PC OF OFFENDING OPEN + POP P,A + .SUSET [.RSNAM,,B] + PUSHJ P,TELL + POP P,LPTSW + POPJ P, + +;ALSO CALLED FROM INT4 (DISK DATA ERROR) +TELL: PSIS (A) + PRINT : + PSIS 1(A) + PSIS 2(A) + PSIS B + PASC [ASCIZ /;/] + PUSHJ P,OPINFL + JRST CRR + +OPINFL: PUSH P,A ;ANALYZE IOC ERROR + .OPEN ERRC,ERROP + .VALUE ;LOSING COMPLETELY! + MOVEI A,40 ;SPACE +ERRLOP: PUSHJ P,TYO + .IOT ERRC,A + CAIL A,40 + JRST ERRLOP + .CLOSE ERRC, + PUSHJ P,CRR +POPAJ: POP P,A + POPJ P, + +;PASC UUO. MAINLY FOR PRINT MACRO. +APASC: MOVE B,40 ;PRINT ASCIZ STRING + HRLI B,440700 +PRINL5: ILDB A,B + JUMPE A,CPOPJ + CAIN A,^Q ;CONTROL-Q TURNS OFF UNDERSCORE MISFEATURE + JRST [ ILDB A,B ? PUSHJ P,TYO ? JRST PRINL5 ] + CAIN A,"_ ;UNDERSCORE GETS MAPPED INTO CR-LF + JRST [ PUSHJ P,CRR ? JRST PRINL5 ] + PUSHJ P,TYO + JRST PRINL5 + +SIXTYO: MOVE C,[440600,,B] ;TYPE 6 SIXBIT CHARACTERS +SIXTY1: ILDB A,C + ADDI A,40 + PUSHJ P,TYO + TLNE C,770000 + JRST SIXTY1 + POPJ P, + +DOT: SKIPA B,[8] +DPT: MOVEI B,10. + MOVEM B,BASE + JUMPL A,NDPT +DPT1: IDIV A,BASE ;DECIMAL OUTPUT ROUTINE + HRLM B,(P) + SKIPE A + PUSHJ P,DPT1 + HLRZ A,(P) + ADDI A,"0 + JRST TYO + +NDPT: PUSH P,A + MOVEI A,"- + PUSHJ P,TYO + POP P,A + MOVNS A + JRST DPT1 + SUBTTL FNG - GET NEXT FILE + +;FNG GETS THE NEXT FILE, MAPPING OVER THE WHOLE WORLD BUT EXCLUDING +; SOME FILES ON BASIS OF DATE, ETC. +;RETURNS FILE NAME AND ATTRIBUTES IN A FEW MILLION VARIABLES, +; WHICH SHOULD BE LISTED HERE. +;CLOBBERS JUST ABOUT ALL THE ACS. + +;THIS ISN'T THE ENTRY, JUMPS HERE IF CAN'T READ UFD. +FUNCT: .STATUS UFDCH,A + LDB A,[220600,,A] ;OPEN-LOSS CODE + CAIN A,20 + POPJ P, ;DIRECTORY DOESN'T EXIST, FAIL. + PUSH P,LPTSW + SETZM LPTSW + PSIS CHNTAB+UFDCH ;MAY JUST BE 'DEVICE NOT AVAILABLE' + PUSHJ P,OPINFL + PUSHJ P,CRR + POP P,LPTSW + MOVEI A,150. + .SLEEP A, + JRST FNG8 + +;ENTRY. +FNG: AOSE FLNI ;PUT ONE FILE NAME AND PACK # IN FN1,FN2,PACKN + JRST NEXFLN ;NOT THE FIRST TIME +FNG8: .OPEN UFDCH,FNO + JRST FUNCT ;MAYBE TOO MUCH DISK ACTIVITY + MOVE A,[-2000,,FDIRBF] + .IOT UFDCH,A + .CLOSE UFDCH, + SKIPN GFRFLG + JRST FNG1 + HRRZ A,FDIRBF+UDBLKS + MOVEM A,BLOCKS + HLRZ A,FDIRBF+UDBLKS + MOVEM A,QUOTA + SKIPE GFREVR + JRST FNG1 + HLRZ A,FDIRBF+UDALLO + JUMPE A,FNG1 + MOVEI B,1 + LSH B,(A) ;BIT FOR PACK ALLOCATED TO + TDNN B,SECMSK ;ALLOCATED TO SECONDARY DOESN'T COUNT + SKIPE GFRALO ;DON'T REAP ALLOCATED DIRS? + JRST FNG1 ; REAP THE SUCKERS! + POPJ P, ;ALLOCATED, DON'T REAP + +FNG1: MOVE A,FDIRBF+UDNAMP + MOVEM A,DIRIDX + ADDI A,FDIRBF ;A POINTS TO BEGINNING OF NAME AREA + MOVE C,A +GETNM: CAILE A,FDIRBF+1777-4 + JRST OUTENT ;END OF NAME AREA + SKIPN W,(A) + JRST NEXENT ;EMPTY SLOT [SHOULDN'T HAPPEN!] + MOVE B,UNRNDM(A) + SKIPN GFRFLG + JRST GETNM2 + SKIPE GFREVR + JRST GETNM1 + TLNN B,UNREAP ;DON'T REAP FILES WITH REAP BIT ON + TLNN B,UNDUMP ;DON'T REAP FILES NOT YET DUMPED + JRST NEXENT + PUSH P,A + LDB A,[UNPKN B] + MOVEI D,1 + LSH D,(A) ;BIT FOR PACK IT'S ON + POP P,A + TDNN D,GFRPNM + JRST NEXENT ;DON'T REAP OFF THIS DISK +GETNM2: TLNN B,UNLINK + JRST GETNM1 + SKIPN DMPLNK + JRST NEXENT +GETNM1: SKIPL INCREM + SKIPGE DATEF + CAIA + JRST IGNORQ + TLNE B,UNLINK ; LINK + JRST NEXENT ; DON'T INCREMENTAL DUMP LINKS + SKIPGE DATEF + JRST IGNORQ + TLNE B,UNDUMP ;FILE-DUMPED BIT + JRST NEXENT + MOVE D,3(A) + CAMN D,[-1] + PUSHJ P,SM1DT ;MINUS 1 DATE, CHANGE INTO TODAY. +IGNORQ: TLNE B,UNIGFL + JRST NEXENT ;FILE IS EITHER OPEN FOR WRITING OR SOME FLAVOR OF BEING DELETED + MOVE D,DATE + SKIPGE DATEF + CAMG D,3(A) ;IF DATE SPECIFIED, DISREGARD IF CREATION + CAIA ; DATE IS BEFORE SPECIFIED DATE + JRST NEXENT + MOVE D,DATE1 + SKIPGE DATESF + CAMLE D,3(A) ;IF DATES SPECIFIED, DISREGARD IF CREATION + CAIA ; DATE IS AFTER SPECIFIED DATE + JRST NEXENT + TLNE B,UNLINK + JRST GETLNK + MOVEM W,(C) ;FIRST NAME + MOVE W,1(A) + MOVEM W,1(C) + LDB W,[UNPKN B] + MOVEM W,2(C) ;PACK # + MOVE W,3(A) + MOVEM W,3(C) + HLRZ W,4(A) ;REFERENCE DATE + SKIPN W + MOVEI W,177777 + ANDI W,177777 + SKIPE GFRCRE ;GET CREATION DATE INSTEAD OFF REFERENCE DATE. + HLRZ W,3(A) + MOVSM W,4(C) + SKIPN GFRFLG + JRST FNGOK + PUSHJ P,LNTH + JUMPE B,NEXENT ;ZERO-LENGTH FILES DON'T GET REAPED + MOVE B,(C) + CAME B,[SIXBIT/-READ-/] + JRST FNGOK + MOVE B,1(C) + CAME B,[SIXBIT/-THIS-/] ;THESE FILES WORTH KEEPING AROUND +FNGOK: ADDI C,LUNBLK ;ACCEPT THIS FILE INTO THE LIST +NEXENT: ADDI A,5 + JRST GETNM + +SM1DT: MOVEI D,.BII ;FILE SEEN WITH -1 CREATION DATE, + HRLM D,TRNI ; AND NOT DUMPED YET. FIX. + MOVE D,(A) + MOVEM D,FN1 + MOVE D,1(A) + MOVEM D,FN2 + .OPEN DSKIN,TRNI + POPJ P, + .CALL RRDATE ;READ REF DATE (= NOW SINCE JUST OPENED!!) + SKIPA + .CALL CREFDT ;COPY INTO CREATION DATE + JFCL + .CLOSE DSKIN, + POPJ P, + +;HACKED ALL ENTRIES, NOW SORT +OUTENT: MOVEM C,LFDIR + SETZM (C) ;ZERO ENTRY MEANS END OF DIRECTORY + SETZM 1(C) + SETZM 4(C) + MOVE A,DIRIDX + ADDI A,FDIRBF + MOVEI D,LUNBLK + MOVEI N,0 ;USUALLY BY FN1 + SKIPE GFRFLG + SKIPN GFRQUO + JRST OUTEN1 + MOVEI N,4 ;SORT BY REFDATE IF GFR AND QUOTA + PUSHJ P,SORT + MOVE A,DIRIDX + ADDI A,FDIRBF + MOVEI N,3 + MOVE C,A +OUTEN2: SKIPN B,4(A) + JRST OUTLUP +OUTEN3: ADDI C,LUNBLK + CAMN B,4(C) + JRST OUTEN3 + PUSHJ P,SORT + JRST OUTEN2 + +OUTEN1: PUSHJ P,SORT + MOVE A,DIRIDX + ADDI A,FDIRBF + MOVEI N,1 ;SORT BY FN2 WITHIN EQUAL FN1 + MOVE C,A +BLUP: SKIPN B,(A) + JRST OUTLUP +BLUP1: ADDI C,LUNBLK + CAMN B,(C) + JRST BLUP1 + PUSHJ P,SORT + JRST BLUP +OUTLUP: ;ESCAPE FROM ABOVE SORTING. DROP INTO NEXFLN. + +;HERE TO EXTRACT A FILE FROM THIS MUNGED DIRECTORY. +NEXFLN: SETZM RFDATE + MOVE A,DIRIDX + SKIPN B,FDIRBF(A) + POPJ P, ;NO MORE FILES + MOVEM B,FN1 + MOVE B,FDIRBF+1(A) + MOVEM B,FN2 + MOVE B,FDIRBF+2(A) + MOVEM B,PACKN + MOVE B,FDIRBF+3(A) + MOVEM B,LNKNM1 + SKIPE GFRFLG + MOVEM B,FLENTH + MOVE B,FDIRBF+4(A) + MOVEM B,LNKNM2 + ADDI A,LUNBLK + MOVEM A,DIRIDX + SETZM LNKFLG + HLRZ A,PACKN + SKIPE A + SETOM LNKFLG + SKIPN LNKFLG + MOVEM B,RFDATE +POPJ1: AOS (P) +CPOPJ: POPJ P, + +GETLNK: MOVEM W,(C) ;FIRST NAME + MOVE W,1(A) + MOVEM W,1(C) + LDB B,[UNDSCP+UNRNDM(A)] ;GET FIRST BYTE INDEX + PUSH P,B+1 + IDIVI B,UFDBYT + ADDI B,FDIRBF+UDDESC + MOVNI N,-6(C) + IMULI N,6 + HRLI N,60200 ;ASSUMING B=2 !!! + ROT N,30. + POP P,B+1 + PUSHJ P,GETLSL + CAMN W,[SIXBIT /BACKUP/] ; DON'T BACKUP LINKS TO THE BACKUP DIRECTORY + JRST NEXENT + SKIPN W + SETOM W ;IN CASE OF ZERO SNAME + MOVEM W,2(C) ; SNAME + PUSHJ P,GETLSL + MOVEM W,3(C) ; LINK FN1 + PUSHJ P,GETLSL + MOVEM W,4(C) + ADDI C,LUNBLK + JRST NEXENT + +;GETLSL GET LINK SYLLABLE. 6 BIT CHARACTERS. AT MOST 6 TO A WORD RETURNED IN W +; NEXT CHARACTER QUOTED BY : DELIMITER IS ; OR ZERO CHARACTER +GETLSL: PUSH P,A + PUSH P,C + PUSH P,D + MOVEI D,6 ;AT MOST 6 CHARACTERS + MOVE C,[440600,,W] + SETZM W +GETLS1: ILDB A,N + CAIE A,0 + CAIN A,'; ; END? + JRST GETLS2 + CAIN A,': ; QUOTE NEXT CHAR + ILDB A,N + IDPB A,C ; STORE CHARACTER + SOJG D,GETLS1 +GETLS2: POP P,D + POP P,C + POP P,A + POPJ P, + +LNTH: LDB D,[UNDSCP+B] + SETZM B + IDIVI D,6 + HLL D,QBTBLI(E) + ADDI D,UDDESC+FDIRBF + PUSHJ P,LN1 + MOVEM B,3(C) + POPJ P, + +LN1: ILDB E,D + SKIPN E + POPJ P, + CAILE E,UDTKMX + JRST LN2 + ADD B,E + JRST LN1 + +LN2: CAIGE E,UDWPH + AOJA B,LN1 + CAIN E,UDWPH + JRST LN1 + REPEAT 2, IBP D + AOJA B,LN1 + +QBTBLI: 440600,, + 360600,, + 300600,, + 220600,, + 140600,, + 060600,, + 000600,, + +;THE FOLLOWING ROUTINE READS IN AND ALPHABETIZES THE MASTER FILE +;DIRECTORY OF THE DISK USING THE ASSUMED NAME M.F.D. (FILE). +;THE DIRECTORY IS READ IN WITH BLOCK IMAGE MODE INPUT INTO MFDLST, +;AND IS ASSUMED TO BE COMPLETELY CONTAINED IN 2000 OCTAL LOCATIONS. +;THE FIRST ENTRY IS ASSUMED TO BE IN LOCATION MFDLST+N, WHERE N IS THE CONTENTS OF MFDLST+1. +;EVERY ENTRY IS ASSUMED TO TAKE TWO LOCATIONS WITH THE NAME TO BE ALPHABETIZED IN THE FIRST +;LOCATION OF THE TWO. +; THE FINAL ALPHABETIZED LIST IS ONE WORD ENTRIES STARTING AT MFDLST. + +;NEXT MFD ENTRY (FOR FNG) +MFDN: SETOM APPENF + AOS A,MFDIN + MOVE A,MFDLST(A) + JUMPE A,CPOPJ + MOVEM A,USNM + JRST POPJ1 + +;READ IN MFD +INMFD: MOVEI A,.BII + HRLM A,MFO + OPEN STATC,MFO + .VALUE ;HOW CAN WE POSSIBLY WIN WITHOUT MFD? + MOVE A,[-2000,,MFDLST] + .IOT STATC,A + .CLOSE STATC, + MOVEI B,0 ;FIRST, COPY IT DOWN INTO CONTIG WORDS + MOVE A,MFDLST+MDNAMP ;LOCATION OF FIRST ENTRY +NEXUFD: SKIPN C,MFDLST(A) + JRST GOON + MOVEM C,MFDLST(B) + ADDI B,1 +GOON: ADDI A,2 + CAIGE A,2000 + JRST NEXUFD + SETZM MFDLST(B) ;MARK END + MOVEI A,MFDLST ;NOW SORT IT + MOVEI C,MFDLST(B) + MOVEI N,0 + MOVEI D,1 + JRST SORT + SUBTTL SORT ROUTINE + +;THIS ROUTINE SORTS A BLOCK OF CORE LOGICALLY (NOT ARITHMETICALLY) +;ARGUMENTS: +;A POINTS TO FIRST ENTRY +;C POINTS TO LOCATION AFTER LAST ENTRY +;N HOLDS ADDRESS OF KEY WORD RELATIVE TO BEGINNING OF BLOCK +;D HOLDS NUMBER OF WORDS TO BE MOVED TOGETHER +;THE METHOD IS RADIX EXCHANGE +;BORROWED FROM SYSENG;PRUFD > +SORTDN: MOVE [TDNE B,(A)] + MOVEM TEST1 + MOVE [TDNN B,(C)] + MOVEM TEST2 + JRST SORTI +SORT: MOVE [TDNN B,(A)] + MOVEM TEST1 + MOVE [TDNE B,(C)] + MOVEM TEST2 +SORTI: MOVSI B,(SETZ) +SORT1: HRLM C,(P) ;SAVE UPPER BOUND + MOVN W,D + ADD W,C + CAML A,W + JRST SORT7 ;ONE OR ZERO ENTRIES + PUSH P,A ;SAVE LOWER BOUND +SORT3: ADD A,N + XCT TEST1 ;BIT SET IN LOWER ENTRY? + JRST SORT5 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN + SUB A,N + SUB C,D + ADD C,N + XCT TEST2 ;BIT CLEAR IN UPPER ENTRY? + JRST SORT8 ;NO, CHECK FOR END, DECREMENT C, AND TRY AGAIN + SUB C,N + IMUL D,[-1,,] ;MAKE AOBJN POINTER +SHUFFL: ADDI A,(D) + ADDI C,(D) + MOVE W,(A) + EXCH W,(C) + MOVEM W,(A) + SUBI A,(D) + SUBI C,(D) + AOBJN D,SHUFFL +SORT4: ADD A,D ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY +SORT2: CAME A,C ;ANY MORE ENTRIES LEFT? + JRST SORT3 ;YES, GO PROCESS THEM + ;A AND C NOW BOTH POINT TO FIRST ENTRY WITH BIT SET + ROT B,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT + POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT + JUMPL B,SORT6 ;JUMP IF NO MORE KEY TO SORT ON + PUSHJ P,SORT1 ;SORT BOTTOM PART OF TABLE + HLRZ C,(P) ;RESTORE UPPER BOUND (SORT1 CLOBBERED A TO MIDDLE) + PUSHJ P,SORT1 ;SORT TOP PART OF TABLE +SORT6: ROT B,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER B" +SORT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED + POPJ P, + +SORT5: SUB A,N + JRST SORT4 + +SORT8: SUB C,N + JRST SORT2 + SUBTTL PROGRAM STARTS HERE + +START: SKIPN MYNAME ;DON'T CHANGE IF NOT JUST LOADED + .SUSET [.RSNAME,,MYNAME] + .SUSET [.SSNAM,,MYNAME] + .SUSET [.ROPTION,,A] + TLO A,%OPOPC ;STORE PROPER PC ON INTERRUPTS + .SUSET [.SOPTION,,A] + .OPEN TYOC,[%TJDIS+.UAO,,(SIXBIT /TTY/)] + .LOSE 1400 + MOVEI P,PDL + .CORE CORSIZ + JRST .-1 + .SUSET [.SMASK,,[%PIIOC+%PITYI]] ;ALLOW IOC, TYPEIN + ;COPY QPKID AND QRESRV ARRAYS OUT OF ITS + MOVE C,[SQUOZE 0,NQS] + .EVAL C, + .LOSE + MOVE A,[SQUOZE 0,QPKID] + .EVAL A, + .LOSE + MOVSS A + HRRI A,QPKID + MOVE B,C + .GETLOC A, + ADD A,[1,,1] + SOJG B,.-2 + MOVE A,[SQUOZE 0,QRESRV] + .EVAL A, + JRST NORSRV + MOVSS A + HRRI A,QRESRV + .GETLOC A, + ADD A,[1,,1] + SOJG C,.-2 +NORSRV: ;SET UP SECMSK TO BE ALL THE PACKS THAT ARE ON-LINE AND RESERVED + SETZM SECMSK + SETZM PRIMSK ;AND PRIMSK THE ON-LINE NON-RESERVED PACKS + MOVSI C,-10 +SETSCM: MOVEI A,1 + SKIPGE QPKID(C) + JRST SETSC1 ;NOT ON-LINE + LSH A,@QPKID(C) + SKIPE QRESRV(C) + IORM A,SECMSK + SKIPN QRESRV(C) + IORM A,PRIMSK +SETSC1: AOBJN C,SETSCM + PUSHJ P,INMFD + .OPEN TYIC,[10,,(SIXBIT /TTY/)] ;DDT MODE + .LOSE 1400 + .CALL TTYGET ;TRY TO TURN ON **MORE** PROCESSING + JFCL + MOVSI C,%TSMOR + ANDCAM C,TTYSTS + .CALL TTYSET + JFCL + .STATUS TYOC,A + LDB A,[300,,A] + MOVEM A,DISPLY + SOS DISPLY ;0==> PAPER 1==> SCREEN + + ;PRINT _ ;CRLF + ;PUSHJ P,FORMF ;CLEAR SCREEN IF DISPLAY + SIXTYP PRNAM1 + PRINT . + SIXTYP PRNAM2 + PUSHJ P,CRR + SETOM ITAPE ;Assume tape is / will be rewound + SETOM MFDDAT + SETOM UFDDAT + SKIPGE TAPTYP + SETOM TAPTYP ;Dismount remote tape + SKIPG WRONG ;Else SETIT will make local/remote decision + JRST MLP + SETZM WRONG ;See if on right machine (first time only) + .CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ] + .VALUE + CAMN A,[MCHN] + JRST MLP + PRINT *** WRONG VERSION OF DUMP--ASSEMBLED FOR + PSIS [MCHN] + PRINT BUT RUNNING ON + PSIS A + PRINT ***_*** CERTAIN TAPE OPERATIONS WON'T BE ALLOWED *** + SETOM WRONG + ;JRST MLP ;drops through + SUBTTL MAIN COMMAND LOOP + +RET: ;FAILURE RETURN FROM VARIOUS COMMANDS +MLP: .CORE CORSIZ + JRST .-1 ;NO CORE + SETZM CTRLG + SETZM ACLODF + SETZM GFRFLG + SETZM GFRCRE + SETZM EOTFLG + SETZM USRDEL + SETZM DATEF + SETZM DATESF + SETZM RELOSW + SETZM PDIRSW + SETZM DMPDIR + SETZM DMPUFD + SETZM DMPMFD + SETZM DMPLNK + SETZM DFINDF + MOVEI P,PDL + CLEARM LPTSW + .CLOSE SAVET, + MOVNI A,1 + SKIPE LPTBFC + PUSHJ P,LPTTYO ;EMPTY THE LPT BUFFER + .CLOSE LPTCH, + .RESET MAGIN, ;ASSUMING MTAPE USES MAGIN AS ITS CHANNEL + .CLOSE MAGIN, ;BEGINNING AND ERROR RESTART + .CLOSE MAGOUT, + SETZM MAGOPN + SETZM LNKFLG + .IOPDL ;FLUSH ANY PUSHED DSKIN, ETC. + .CALL TTYSET ;TURN ECHOING BACK ON, IF OFF + JFCL +PROMPT: PUSHJ P,CRR + MOVEI A,"_ + PUSHJ P,TYO ;PROMPT THE LOSER + PUSHJ P,TYI + CAIN A,"? + JRST AHELP + PUSHJ P,GETSL1 ;READ THE COMMAND + JRST PROMPT + JUMPE SYM,RET ;JUST A CR OR FF, REPROMPT + CLEARM SUPERC + CLEARM DMPMOD + CLEARM CHKFLG + CLEARM TCOPYF + MOVSI B,-NCOMS + CAME SYM,COMT(B) ;SEARCH THE COMMAND TABLE + AOBJN B,.-1 + MOVEI C,0 ;USED IN SOME COMMANDS AS DEFAULT + JUMPL B,MLP1 ;NOT REASONABLE COMMAND ? +ERR: PRINT ? + JRST MLP + +FORMF: SKIPG DISPLY + POPJ P, + PASC [ASCIZ /C/] + POPJ P, + +MLP1: SKIPGE COMDTB(B) ;NOT ALL COMMANDS USE THE TAPE DRIVE + PUSHJ P,SETITN ;SETIT, and show who used it last. + PUSHJ P,@COMDTB(B) ;DO COMMAND + JRST RET + +AHELP: PASC COMHLP ;GIVE COMMAND NAMES AND DESCRIPTION + JRST MLP +; MOVSI D,-NCOMS ;LIST COMMANDS +; PUSHJ P,CRR +;HELP1: PSIS COMT(D) +; PUSHJ P,CRR +; AOBJN D,HELP1 +; JRST MLP + SUBTTL COMMAND LOOK-UP TABLES + + ;NOTE IF YOU CHANGE THIS, CHANGE COMDTB AND COMHLP (ALSO ON THIS PAGE) +COMT: SIXBIT /LOCAL/ ;USE LOCAL TAPE DRIVE + SIXBIT /REMOTE/ ;USE REMOTE TAPE DRIVE + SIXBIT /TAPED/ ;GENERATE TAPE DIRECTORY FROM MOUNTED TAPE + SIXBIT /FIND/ ;FIND WHAT TAPE PARTICULAR FILE IS ON + SIXBIT /OFIND/ ;FIND COMMAND USING A TAPE FOR INFO + SIXBIT /DFIND/ ;FIND COMMAND FOR A DECEASED ITS. + SIXBIT /DUMP/ ;DUMP FILES + SIXBIT /LOAD/ ;LOAD FILES + SIXBIT /RELOAD/ ;LOAD FILES, MODIFY DIRECTORY FROM TAPE COPY + SIXBIT /CLOAD/ ;CONTINUE PREVIOUS LOAD OPERATION + SIXBIT /CDUMP/ ;CONTINUE FULL DUMP + SIXBIT /REWIND/ ;REWIND MAG TAPE + SIXBIT /UNLOAD/ ;REWIND/UNLOAD + SIXBIT /FLAP/ ;REWIND/UNLOAD + SIXBIT /EOT/ ;GO TO END OF TAPE + SIXBIT /LIST/ ;LIST FILES ON TAPE + SIXBIT /MFD/ ;LIST OUT MFD + SIXBIT /LISTF/ ;LIST OUT FILE DIRECTORY + SIXBIT /HELP/ ;TYPE OUT COMMANDS + SIXBIT /SPACE/ ;SPACE FORWARD N FILES + SIXBIT /LSPACE/ ;SPACE FORWARD AND LIST FILES + SIXBIT /CHECK/ ;CHECK FILES + SIXBIT /LCHECK/ ;CHECK FILES AND LIST THEM + SIXBIT /TAPES/ ;LIST ALL SAVED TAPE INFO + SIXBIT /TAPE/ ;LIST SAVED INFO ABOUT ONE TAPE + SIXBIT /TAPSET/ ;SET TAPE INFO FOR ONE TAPE + SIXBIT /TLIST/ ;LIST FILES ON A TAPE(AS STORED ON DISK) + SIXBIT /GFR/ ;GRIM FILE REAPER + SIXBIT /QUIT/ ; REWIND AND KILL + SIXBIT /ICHECK/ + SIXBIT /ERRSTS/ ;TAPE CONTROL STATUS AS OF LAST ERROR + SIXBIT /ALLOC/ ;SET/GET DIRECTORY ALLOCATION + SIXBIT /LSTALC/ ;LIST ALL ALLOCATED DIRECTORIES + SIXBIT /PTDIR/ ;PRINT DIRECTORIES FROM TAPE +NCOMS==.-COMT + +COMHLP: ASCIZ\ +LOCAL Use local tape drive on this machine +REMOTE Use remote tape drive over the Chaos network +FIND Find what tape a particular file is on +OFIND FIND command using a tape for info +DFIND FIND command for a deceased ITS +DUMP Dump files +LOAD Load files +RELOAD Load files, modify directory from tape copy +CLOAD Continue previous LOAD/RELOAD operation +CDUMP Continue full dump +REWIND Rewind mag tape +UNLOAD Rewind/unload +EOT Go to end of tape +SPACE Space forward n files +LSPACE Space forward and list files, hit after each +LIST List files on tape +MFD List MFD from disk +LISTF List a file directory from disk +HELP Type out commands +CHECK Check files on tape against disk +LCHECK Check files and list them +ICHECK Check files on incremental dump, update dump-check bits +TAPED Generate tape directory from mounted tape +TAPES List all saved tape info +TAPE List saved info about one tape +TAPSET Set tape info for one tape +TLIST List files on a tape (from tape directory stored on disk) +GFR Grim File Reaper (Don't use this, please) +QUIT return to DDT +ERRSTS Print tape control status as of last error +ALLOC Examine or change directory allocation +LSTALC List all directories with allocations +PTDIR Print directories from tape +\ + +COMDTB: ALOCAL ;SETZ MEANS THAT COMMAND USES THE TAPE DRIVE + AREMOTE + ATAPED + AFIND + SETZ OFIND + DFIND + SETZ DUMP + SETZ LOAD + SETZ RELOAD + SETZ ACLOAD + SETZ ACDUMP + ARWND + AUNLD + AUNLD + AEOT + SETZ ALIST + AMFD + ALISTF + AHELP + SETZ ASPACE + SETZ ALSPACE + SETZ ACHECK + SETZ ALCHEC + ATAPES + ATAPE + TAPSET + ATLIST + AGFR + AQUIT + AICHEC + ERRSTS + DALLOC + LSTALC + SETZ APTDIR +IFN .-COMDTB-NCOMS, .ERR COMDTB NOT SAME LENGTH AS COMT + SUBTTL TTY I/O + +TYI: .IOT TYIC,A ;TTY IN + JUMPL A,TYICC1 ;EOF ON INDIRECT FILE + CAIN A,^C ;IGNORE GARBAGE CHARS + JRST TYI + CAIN A,^G + JRST TYI + CAIL A,"a ;UPPER CASE LOWER CASE LETTERS + CAILE A,"z + CAIA + SUBI A,40 + SKIPE TYIPD + JRST TYIDSK + CAIE A,15 + POPJ P, + PUSHJ P,CAR ;CR ECHOS AS CRLF + MOVEI A,15 + POPJ P, + +TYIDSK: CAIN A,12 + JRST TYI ;IGNORE LINE FEEDS IN DISK INPUT + JRST TYO ;ECHO STUFF ON TTY + +TYICC1: SKIPG TYIPD + POPJ P, + SOS TYIPD ;AT END OF INDIRECT FILE + .IOPOP TYIC, + JRST TYI + +;RETURN CARRIAGE +CRR: MOVEI A,15 +CAR: PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;TTY/LPT/TPL OUT +TYO: SKIPGE LPTSW + JRST LPTTYO +TYO1: .IOT TYOC,A + POPJ P, + +LPTBUF: BLOCK 40 +LPTBEP: 010700,,.-1 +LPTBBP: 440700,,LPTBUF +LPTBFP: 440700,,LPTBUF +LPTBFC: 0 + +LPTTYO: PUSH P,B + JUMPL A,LPTTO1 + IDPB A,LPTBFP + AOS LPTBFC + CAIN A,^J + JRST LPTTO1 + MOVE B,LPTBFP + CAME B,LPTBEP + JRST POPBJ +LPTTO1: MOVE B,LPTBBP + MOVEM B,LPTBFP + .CALL [ SETZ + SIXBIT /SIOT/ + MOVEI LPTCH + MOVE B + SETZ LPTBFC ] + .LOSE 1000 + SETZM LPTBFC +POPBJ: POP P,B + POPJ P, + +TYOS: PUSH P,A + MOVEI A,40 ;OUTPUT SPACE + PUSHJ P,TYO + JRST POPAJ + SUBTTL SYLLABLE INPUT + +;THE FOLLOWING ROUTINE INPUTS A SYLLABLE. +;THE SYLLABLE ENDS UP AS SIXBIT IN SYM. +;IF IT IS COMPOSED OF DIGITS, THEY ARE COMPILED INTO A DECIMAL NUMBER +;AND STORED IN N. +;CARRIAGE RETURN, LINEFEED, SEMI-COLON, COLON, BACKARROW, AND ALTMODE END THE +;SYLLABLE BUT ARE NOT PART OF IT. THE TERMINATOR IS PUT IN TER. +;NON-SIXBIT CHARACTERS CAUSE GETSYL TO PRINT ?? AND WAIT FOR THE +;ENTIRE SYLLABLE AGAIN. SINGLE CHARACTER RUBOUT WORKS, +;BUT IF YOU RUBOUT BEYOND THE FIRST CHARACTER, GETSYL RETURNS WITHOUT +;SKIPPING. SUCCESSFUL RETURN IS A SKIP RETURN. ^Q MAY BE USED TO ENTER +;A TERMINATOR AS SIXBIT SUCH AS SEMI-COLON, OR COLON. +;RUBBED OUT CHARACTERS ARE ECHOED. +GETSYL: SETZB N,GTSYCC ;CLEAR SIXBIT VALUE, NUMERIC VALUE, + SETZB SYM,GTSYNF ; CHARACTER COUNT, NEGATIVE FLAG + MOVE B,[440600,,SYM] +GETCH: PUSHJ P,TYI +SKCHAR: CAIN A,177 + JRST RUBOUT + CAIE A,"_ ;BACK-ARROW + CAIN A,33 ;ALTMODE + JRST OUTSYL + CAIE A,15 ;CARRIAGE RETURN + CAIN A,12 ;LINEFEED + JRST OUTSYL + CAIE A,"; ;SEMI-COLON + CAIN A,": ;COLON + JRST OUTSYL + CAIN A,40 ;SPACE + JRST OUTSYL + CAIN A,^L ;SO USER CAN CLEAR SCREEN + JRST GETSFF + CAIN A,^Q + JRST QUOTE + CAIGE A,40 + JRST OUTSYL ;ANY RANDOM CONTROL TERMINATES + CAIN A,"- + SETCMM GTSYNF +NUMQ: CAIGE A,40 + JRST CHERR + CAIL A,"0 + CAILE A,"9 + JRST NONUM + IMULI N,10. + ADDI N,-"0(A) +NONUM: SUBI A,40 + TLNE B,770000 + IDPB A,B + AOS GTSYCC + JRST GETCH + +QUOTE: PUSHJ P,TYI + CAIE A,177 + JRST NUMQ ;RUB OUT QUOTE RATHER THAN QUOTING RUBOUT + .CALL [ SETZ ? 'CNSGET ? MOVEI TYOC + REPEAT 4,[ MOVEM A ? ] SETZM A ] ;GET TTYOPT + MOVEI A,0 + TLNE A,%TOOVR + TLNE A,%TOERS + JRST [ PRINT XX + JRST GETCH ] + PRINT ^Q + JRST GETCH + +GETSFF: SKIPN GTSYCC + JRST OUTSYL ;NOTHING TYPED, TERMINATE + PUSH P,N ;OTHERWISE, RE-ECHO + MOVE N,[440600,,SYM] + SETZM GTSYCC ;NOTE TRUNCATES TO AT MOST 6 CHARS +GETSF1: ILDB A,N + ADDI A,40 + AOS GTSYCC + PUSHJ P,TYO + CAME N,B + JRST GETSF1 + POP P,N + JRST GETCH + +RUBOUT: SKIPN GTSYCC + JRST RUB1 + LDB A,B + ADDI A,40 + PUSH P,C + .CALL [ SETZ ? 'CNSGET ? MOVEI TYOC + REPEAT 4,[ MOVEM C ? ] SETZM C ] ;GET TTYOPT + MOVEI C,0 + TLNE C,%TOOVR + TLNE C,%TOERS + JRST [ PUSH P,A + MOVEI A,^P + PUSHJ P,TYO + MOVEI A,"X + PUSHJ P,TYO + POP P,A + JRST RUB0 ] + PUSHJ P,TYO +RUB0: POP P,C + CAIL A,"0 + CAILE A,"9 + JRST NOUNM + SUBI N,-"0(A) + PUSH P,SYM + IDIVI N,10. + POP P,SYM ;DIVISION CLOBBERS SYM +NOUNM: SOS A,GTSYCC + CAIL A,6 + JRST GETCH + SETZ A, + DPB A,B + ADD B,[60000,,] + JRST GETCH + +RUB1: PRINT ?? + PUSHJ P,TYOS + POPJ P, + +CHERR: PRINT ?? + PUSHJ P,TYOS + JRST GETSYL + +OUTSYL: MOVEM A,TER + AOSN GTSYNF + MOVNS N + JRST POPJ1 + +GETSL1: SETZB N,GTSYCC ;CLEAR SIXBIT VALUE, NUMERIC VALUE, + SETZB SYM,GTSYNF ; CHARACTER COUNT, NEGATIVE FLAG + MOVE B,[440600,,SYM] + JRST SKCHAR + SUBTTL INTERRUPT ROUTINE + +INT: 0 + 0 + PUSH P,A + MOVE A,INT + TRZE A,%PITYI + JRST TYILK ;CHARACTER TYPED + POP P,A +INTGO: MOVEM 17,INTAC+17 + MOVEI 17,INTAC + BLT 17,INTAC+16 ;SAVE ACS + MOVE 17,INTAC+17 + PUSH P,LPTSW + SETZM LPTSW ;TYPE IOCER MESSAGE ON TTY NOT LPT + MOVE A,INT + TRNN A,%PIIOC + JRST RNDINT ;NOT TTY OR IOC + .SUSET [.RBCHN,,A] ;IOCER, GET CHANNEL + CAIN A,MAGIN + JRST INT1 + CAIN A,DSKIN + JRST INT3 + CAIN A,DSKOUT + JRST INT5 + CAIE A,RTAPE"RSICH + CAIN A,RTAPE"RSOCH + JRST [ SKIPGE TAPTYP + SETOM TAPTYP ;REMOTE TAPE CONNECTION BROKEN + JRST .+1 ] + CAIE A,MAGOUT ;NOT MACRO-TAPE INPUT + JRST NTMGTP ;NOT MACRO TAPE OUTPUT EITHER ! + SKIPN DMPMOD + JRST NTDMMP ;NOT DUMPING ON MACRO-TAPE + .STATUS MAGOUT,A + LDB A,[330600,,A] ;IOCER FIELD + CAIE A,9 + JRST NTNDOF ;NOT END OF TAPE +NTNDO1: MOVEI A,FOOB ;AH ! I KNOW HOW TO HANDLE END OF TAPE ! + SKIPGE FULLDMP + JRST INTX1 ;CAUSE PROGRAM TO RESTART AT FOOB + PRINT _PHYSICAL END OF TAPE + .DISMISS [ERR] + +RNDINT: PRINT _INTERRUPT + POCT A + .DISMIS [ERR] + +NTMGTP: PRINT _INTERRUPT ON CHANNEL + POCT A + PSIS CHNTAB(A) ;TYPE DEVICE AND DIRECTION + .DISMIS [NAUGHT] + +NTDMMP: PRINT _INTERRUPT MAG TAPE OUT WHEN NOT DUMPING + .DISMIS [NAUGHT] + +NTNDOF: PUSH P,A + PUSHJ P,ERRSTS ;PRINT MAGTAPE ERROR STATUS + POP P,A + PRINT _INTERRUPT + POCT A + PRINT MAG TAPE OUT .. SIMULATING E-O-T .. + JRST NTNDO1 + +CHNTAB: SIXBIT /RANDOM/ + SIXBIT /MFD IN/ + SIXBIT /DRC IN/ + SIXBIT /DSK IN/ + SIXBIT /MAGOUT/ + SIXBIT /TTY IN/ + SIXBIT /TTYOUT/ + SIXBIT /DSKOUT/ + SIXBIT /MAG IN/ + SIXBIT /LPTOUT/ + SIXBIT /ERR IN/ + SIXBIT /STATUS/ + SIXBIT /SAVET/ + SIXBIT /SNPLCH/ + SIXBIT /RMT IN/ + SIXBIT /RMTOUT/ + +;IOCER ON DISK OUTPUT, MOST LIKELY DEVICE OR DIRECTORY FULL +;LET DDT HANDLE IT. +INT5: MOVE A,INT+1 ;SAVE PC + MOVEM A,IOCPC' + JSP A,INTX1 ;DISMISS AND COME BACK + ;PASS THE ERROR TO DDT + .CALL [SETZ ? SIXBIT/LOSE/ ? MOVEI <1+.LZ %PIIOC> ? SETZ IOCPC] + .VALUE + +;DISK INPUT ERROR +INT3: .STATUS DSKIN,A + LDB A,[330600,,A] ;IOCER FIELD + CAIN A,3 + JRST INT4 ;JUMP IF IRRECOV DATA ERROR + PRINT INTERRUPT + POCT A + PRINT DISK IN + .DISMIS [NAUGHT] + +INT4: SKIPN SUPERC + PRINT DATA ERROR DISK IN_ + AOS ERRDSK + SETOM ERRALL + HRRZ C,INT+1 + POCT C ;PC OF LOSING INSTRUCTION + MOVE A,[DSKIN,,INTERR] + .RCHST A, + MOVEI A,INTERR + MOVE B,INTERR+3 + PUSHJ P,TELL + AOS INT+1 ;ABANDON THE .IOT THAT LOST + JRST INTX + +TYILK: MOVEM A,INT ; DON'T DROP OTHER INTERRUPTS! +TYILK1: MOVEI A,TYIC ;CHARACTER TYPED + .ITYIC A, + JRST POPEN + CAIE A,^G + JRST TYILK1 + .RESET TYOC, + SKIPN A,CTRLG ;SKIP IF DEFERRED + .DISMIS [ERR] ;DEATH TO CURRENT OPERATION + MOVNM A,CTRLG ;SET IT POSITIVE TO FLAG DEFERRED + JUMPL A,TYILK1 ;JUMP IF ^G TYPED FOR THE FIRST TIME + SKIPGE TAPTYP ;^G WHILE DEFERRED, KILL REMOTE TAPE CONNECTION + SETOM TAPTYP + .DISMIS [ERR] + +CTRLGX: AOSG CTRLG + POPJ P, ;NO ^G HAPPENED WHILE DEFERRED + JRST ERR + +POPEN: POP P,A + SKIPE INT ; Any more pending? + JRST INTGO ; Yes, go do 'em + .DISMIS INT+1 ; No, all done + +NAUGHT: PUSHJ P,OPINFL + JRST ERR + +;Can only get here for local tape drive +INT1: PUSH P,TAPTYP ;Select local drive if in TCOPY + MOVEI A,1 + MOVEM A,TAPTYP + PUSHJ P,ERRSTS ;PRINT MAG TAPE ERROR STATUS + .STATUS MAGIN,A ;INTERUPT ON MAG TAPE INPUT + LDB A,[330600,,A] ;IOCER FIELD + CAIN A,3 + JRST INT2 ;NON RECOV DATA ERR + POP P,TAPTYP + CAIN A,9 + SKIPE TCOPYF + JRST INT1B ;PHYSICAL EOT OR TCOPYING + SKIPE DMPMOD ;IF DOING A DUMP, MUST BE A COMPARE + JRST INT1A + PRINT _INTERRUPT + POCT A + PRINT MAG TAPE IN + .DISMIS [NAUGHT] + +;--- This is preposterously bogus, but fortunately is never reached +;--- since ICHECK+5 doesn't check last directory on reel +INT1A: POP P,LPTSW + .DISMIS [ICKEOT] + +INT1B: SETOM RDERR + SETOM PHYEOT + PRINT PHYSICAL END OF INPUT TAPE_ + AOS INT+1 ;CAUSE .IOT TO RETURN WITHOUT READING + JRST INTX + +INT2: AOS ERRCNT + SETOM ERRALL + PUSHJ P,TAPN + PSIS HSNM + PSIS HFN1 + PSIS HFN2 + PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._ + PUSHJ P,OPINFL + SETOM RDERR +IFN NEWCOD, .STATUS MAGIN,B + .CLOSE MAGIN, +IFE NEWCOD, CONI 344,B + TRNE B,TF%EOF ;EOF? + JRST INT2X ;YES + .OPEN MAGIN,MAGI ;NO, SKIP TO EOF + JFCL + AOS INT+1 ;SKIP OVER THE .IOT THAT LOST, NOTE THAT + PUSHJ P,FILSKP ; 'RDERR' HAS BEEN SET, HOPEFULLY WE WERE +INT2X: POP P,TAPTYP ; IN 'MAGREAD' WHEN THE ERROR OCCURRED. + JRST INTX + SUBTTL MAG TAPE STATUS DECODER + +ERRSTS: SKIPGE TAPTYP + JRST RTAPE"PRSTS ;Print remote tape status + PRINT _MAG TAPE STATUS + MOVE A,[SQUOZE 0,MGEMTC] + .EVAL A, + .LOSE + MOVSS A + HRRI A,A + .GETLOC A, ;A GETS CONI MTC, AT TIME OF ERROR +IFE NEWCOD,[ + LDB B,[110400,,A] ;FUNCTION + PASC @(B)[[ASCIZ/NO-OP/] ;0 + [ASCIZ/REWIND/] + [ASCIZ/READ/] + [ASCIZ/READ-COMPARE/] + [ASCIZ/WRITE/] + [ASCIZ/WRITE-EOF/] + [ASCIZ/SPACE-FWD/] + [ASCIZ/SPACE-REV/] + [ASCIZ/AWAIT-UNIT-READY/] ;10 + [ASCIZ/UNLOAD/] + [ASCIZ/READ-MULTI-RECORD/] + [ASCIZ/READ-COMPARE-MULTI-RECORD/] + [ASCIZ/ERASE-THEN-WRITE/] + [ASCIZ/ERASE/] + [ASCIZ/SPACE-FILE-FWD/] + [ASCIZ/SPACE-FILE-REV/]] + LDB B,[060200,,A] + PSIS (B)[SIXBIT/200BPI556BPI800BPI???BPI/] + LDB B,[160100,,A] + SIXTYP (B)[SIXBIT/ ODD EVEN /] + PRINT PAR + LDB B,[150100,,A] + SKIPN B + PRINT IBM MODE + PRINT _ + SETCM D,A + ANDI D,7 ;= 0 IF DATA CHANNEL + MOVE A,[SQUOZE 0,MGEMTS] + .EVAL A, + .LOSE + MOVSS A + HRRI A,A + .GETLOC A, ;A GETS CONI MTS, AT TIME OF ERROR + SKIPE D + TLZ A,170 ;CLEAR CHANNEL STATUS IF NO CHANNEL + MOVSI B,-LMTSTB/2 +ERRST1: TDNE A,MTSTAB(B) + PASC @MTSTAB+1(B) + AOS B + AOBJN B,ERRST1 + POPJ P, + +MTSTAB: 10 ? [ASCIZ/WRITE-LOCK /] + 200 ? [ASCIZ/BAD-TAPE /] + 400 ? [ASCIZ/DATA-LATE /] + 2000 ? [ASCIZ/READ-COMPARE-ERROR /] + 4000 ? [ASCIZ/END-OF-TAPE /] + 10000 ? [ASCIZ/END-OF-FILE /] + 20000 ? [ASCIZ/TAPE-PARITY-ERROR /] + 40000 ? [ASCIZ/ILLEGAL-COMMAND /] + 100000 ? [ASCIZ/BEGINNING-OF-TAPE /] + 200000 ? [ASCIZ/REWINDING /] + 400000 ? [ASCIZ/UNIT-HUNG /] + 20,, ? [ASCIZ/CHANNEL-DATA-PARITY-ERROR /] + 40,, ? [ASCIZ/CHANNEL-NXM-ERROR /] + 100,, ? [ASCIZ/CHANNEL-CONTROL-WORD-PARITY-ERROR /] +LMTSTB==.-MTSTAB +];IFE NEWCOD +.ELSE [;--- JTW missed this routine + DIE TM03 error status decode routine needs to be written +];IFN NEWCOD + SUBTTL DIRECTORY ALLOCATION COMMAND + +DALLOC: PRINT [ DIR=] + PUSHJ P,GETSYL + POPJ P, + .CALL [ SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH] + [SIXBIT/DSK/] ? [SIXBIT/.FILE./] ? [SIXBIT/(DIR)/] ? SETZ SYM] + JRST OPINFL + MOVE A,[-2000,,UFDBUF] + .IOT UFDCH,A + .CLOSE UFDCH, + HLRZ A,UFDBUF+UDBLKS + JUMPE A,[ PRINT [_NO QUOTA] + JRST DALLC1 ] + PRINT [_QUOTA=] + PDPT A +DALLC1: PRINT [, USED=] + HRRZ A,UFDBUF+UDBLKS + PDPT A + SKIPN UFDBUF+UDALLO + JRST [ PRINT [, NO ALLOCATION] + JRST DALLC2 ] + PRINT [, ALLOCATED TO PACK ] + HLRZ A,UFDBUF+UDALLO + PDPT A + HRRZ A,UFDBUF+UDALLO + JUMPE A,DALLC2 + PRINT [, BLKS=] + PDPT A +DALLC2: PRINT [_CHANGE ALLOCATION?] +DALLC3: PUSHJ P,TYI + MOVE D,A + PUSHJ P,CRR + CAIE D,"N + CAIN D,"Y + JRST DALLC4 + PRINT [(Y or N) ] + JRST DALLC3 + +DALLC4: CAIE D,"Y + POPJ P, + .SUSET [.SSNAME,,UFDBUF+UDNAME] + MOVE A,UFDBUF+UDNAMP + CAIN A,2000 + JRST [ MOVSI B,'FOO ;DIR EMPTY, MAKE DUMMY FILE + MOVEM B,FN1 + MOVEM B,FN2 + MOVEI B,.UIO + HRLM B,TRNI + OPEN DSKIN,TRNI + POPJ P, + PUSHJ P,DALLC5 + .FDELE TRNI + JFCL + POPJ P, ] + MOVE B,UFDBUF+UNFN1(A) + MOVEM B,FN1 + MOVE B,UFDBUF+UNFN2(A) + MOVEM B,FN2 +DALLC5: MOVEI B,.BII+30 ;DON'T SET REF DATE, DON'T CHASE LINKS + HRLM B,TRNI + OPEN DSKIN,TRNI + POPJ P, + PRINT [NEW QUOTA=] + PUSHJ P,GETSYL + POPJ P, + MOVE W,N + PRINT [_NEW ALLOCATED PACK=] + PUSHJ P,GETSYL + POPJ P, + HRLZ X,N + PRINT [_NEW ALLOCATED #BLOCKS=] + PUSHJ P,GETSYL + POPJ P, + HRR X,N + .CALL [ SETZ ? 'DIRSIZ ? MOVEI DSKIN ? MOVE W ? SETZ X ] + JRST OPINFL + PRINT [_DONE] + POPJ P, + +;COMMAND TO LIST ALL DIRECTORY ALLOCATIONS + +LSTALC: PUSHJ P,DEVGET + SETOM MFDIN + MOVEI A,.BII + HRLM A,FNO +LSTAL1: PUSHJ P,MFDN + POPJ P, + .SUSET [.SSNAME,,USNM] + OPEN UFDCH,FNO + POPJ P, + MOVE A,[-2000,,UFDBUF] + .IOT UFDCH,A + .CLOSE UFDCH, + HLRZ A,UFDBUF+UDBLKS ;QUOTA + SKIPN UFDBUF+UDALLO + JUMPE A,LSTAL1 ;SKIP THIS IF NOTHING INTERESTING + SIXTYP USNM + JUMPE A,LSTAL2 + PRINT [ QUOTA=] + PDPT A +LSTAL2: SKIPN UFDBUF+UDALLO + JRST LSTAL3 + PRINT [ ALLOCATED TO PACK #] + HLRZ A,UFDBUF+UDALLO + PDPT A + HRRZ A,UFDBUF+UDALLO + JUMPE A,LSTAL3 + PRINT [, ALLOCATION=] + PDPT A +LSTAL3: PRINT [, BLOCKS USED=] + HRRZ A,UFDBUF+UDBLKS + PDPT A + PUSHJ P,CRR + JRST LSTAL1 + SUBTTL END OF TAPE ROUTINE + +FOOB: MOVE P,ERRPDP ;POPJ P, will return from ADMP3 + POP P,A ;Remove that return PC from pdl + MOVEM P,INTAC+P + SKIPL LSTWHL + JRST FOOB1 + MOVEI A,^L + SKIPE LPTSW + PUSHJ P,TYO ;PAGE THROW ON LPT BETWEEN REELS +FOOB1: PUSH P,LPTSW + SETZM LPTSW + SKIPL TAPTYP + .CLOSE MAGOUT, + SKIPG TAPTYP + PUSHJ P,RTAPE"BUFRST + SETZM MAGOPN + SKIPN EXPERM + SKIPN INCREM + JRST FOOE ;JUMP IF NOT TO CHECK + SKIPE CKIDMP + JRST FOOE ;.. + PRINT _REWINDING +IFE MCOND DM,[ + MOVE B,NFTDMP + SOS B + MOVN N,NFTDMP + CAMN B,ITAPE ;IF NOT EQUAL, THEN IT IS NOT THE WHOLE TAPE + JRST FOOB1A + PUSHJ P,ASPAC1 + SKIPA +] +FOOB1A: PUSHJ P,ARWND + PRINT _CHECKING INCREMENTAL DUMP_ + PUSH P,USNM + PUSHJ P,ICHECK + POP P,USNM + .SUSET [.SSNAM,,USNM] + SETZM NFTDMP +FOOE: PUSHJ P,ARWND ;REWIND IT + PUSHJ P,GESELL ;GIVE AWAY BEGINNING AND LAST USER ON THIS REEL + .RESET TYIC, +FOOD: PRINT _MOUNT NEW TAPE THEN TYPE OK. + PUSHJ P,GETSYL + JRST .-1 + MOVE A,SYM + CAMN A,[SIXBIT /OK/] + JRST FOOC + CAMN A,[SIXBIT /STOP/] + JRST MAYBE + JRST FOOD + +FOOC: PUSHJ P,ARWND + AOS NTAPES + MOVE A,USNM + CAME A,FUSNM ;SEE IF ONE DIR FILLED UP THE WHOLE REEL + JRST FOOF + SIXTYP A + PRINT [ DIRECTORY FILLS WHOLE REEL, CONTINUING ONTO ANOTHER REEL._] + SOS FLNI ;DO MOST RECENT FILE AGAIN + MOVEI A,ADMP2 + JRST INTX1 + +FOOF: MOVEM A,FUSNM + SKIPGE FULLDMP + SETOM DMPMFD ;DUMP THE MFD AGAIN AT START OF NEXT REEL + SKIPGE FULLDMP + SETOM DMPDIR ;REDO SAME DIRECTORY AGAIN + SETOM APPENF ;SO USER UFD WILL BE OPENED + MOVEI A,DMPAGN ;RESTART LOCATION FOR NEXT REEL +INTX1: HRRZM A,INT+1 +INTX: POP P,LPTSW + MOVSI 17,INTAC + BLT 17,17 ;RESTORE ACS + .DISMIS INT+1 + +MAYBE: PRINT GIVE UP ? + PUSHJ P,TYI + CAIE A,"Y + JRST FOOD + JRST MLP ;HE REALLY WANTS TO STOP DUMPING NOW + +GESELL: SETOM SDONE + MOVEI A,1 + SKIPE ARCHVF + MOVEM A,SDONE + PUSHJ P,SINFO + PRINT REEL + PDPT NTAPES ;OUTPUT REEL NUMBER AND USER SPAN ON THIS REEL + PRINT FIRST USER = + PSIS FUSNM + PRINT LAST USER = + PSIS LUSNM + JRST CRR + SUBTTL LOAD, RELOAD, DUMP, CDUMP COMMANDS + +RELOAD: PRINT THIS WILL SMASH YOUR DIRECTORY. + PUSHJ P,CHECK + SETOM RELOSW ;RELOAD DISKS FROM TAPE + JRST LOAD + +ACDUMP: SETOM CDMFL ;CONTINUE FULL DUMP + SKIPA +DUMP: CLEARM CDMFL + SETOM DMPMOD ;GENERALISED DUMP + SKIPA +LOAD: CLEARM DMPMOD ;GENERALISED LOAD + MOVSI A,-NFIGS ;CLEAR OPTIONS + CLEARM @FIGTB2(A) + AOBJN A,.-1 + CLEARM MICFLG + CLEARM CUSN + SETOM DPACK + MOVEI A,1 + MOVEM A,THTYPE + CAIN TER,15 + JRST EXECU ;NO SWITCHES FORTH COMING +LOOP: PUSHJ P,TYI + CAIN A,"? + JRST FIGLST ;GIVE INFO ON OPTIONS AVAILABLE + PUSHJ P,GETSL1 + POPJ P, ;OVER-RUBOUT, FLUSH + PUSHJ P,SPACET ;PROCESS OPTION + CAIN TER,15 + JRST EXECU + JRST LOOP + +SPACET: JUMPE SYM,CPOPJ + MOVSI A,-NFIGS + CAMN SYM,FIGTB1(A) + JRST SPASED + AOBJN A,.-2 + SUB P,[1,,1] ;UNKNOW OPTION, BARF + PRINT ? + PSIS SYM + PUSHJ P,TYOS + PRINT IGNORED + PUSHJ P,TYOS + JRST LOOP ;BUT DON'T GIVE UP ENTIRELY + +SPASED: SETOM @FIGTB2(A) ;SET FLAG FOR OPTION SPECIFIED + POPJ P, + +FIGLST: PASC FIGHLP ;LIST OPTIONS AND DESCRIPTIONS + JRST LOOP + +;CONTINUE LOADING WITH SAME OPTIONS COMMAND +ACLOAD: .SEE FLUSH ;AS IT STANDS, THIS CAN'T WORK!! + DIE SORRY THIS COMMAND DOESN'T WORK + MOVE A,CLOADF ;RESTORE OPTIONS + MOVEM A,DMPMOD + JUMPL A,[DIE [LAST OPERATION WAS DUMP]] + MOVE A,CLOADF+1 + MOVEM A,RELOSW + MOVE A,CLOADF+2 + MOVEM A,LENGTH + MOVSI A,-NFIGS + MOVEI B,3 +ACLOD1: MOVE C,CLOADF(B) + MOVEM C,@FIGTB2(A) + ADDI B,1 + AOBJN A,ACLOD1 + SETOM ACLODF + JRST EXECU ;GO EXECUTE IT + + ;NOTE IF UPDATE THIS, UPDATE FIGTB2 AND FIGHLP (ALSO ON THIS PAGE) +FIGTB1: SIXBIT /INCREM/ + SIXBIT /I/ + SIXBIT /MERGE/ + SIXBIT /M/ + SIXBIT /FULL/ + SIXBIT /F/ + SIXBIT /CARE/ + SIXBIT /C/ + SIXBIT /EXPERI/ + SIXBIT /E/ + SIXBIT /LIST/ + SIXBIT /L/ + SIXBIT /SORRY/ + SIXBIT /S/ + SIXBIT /NOASK/ + SIXBIT /DECIDE/ + SIXBIT /D/ + SIXBIT /DATE/ + SIXBIT /DATES/ + SIXBIT /ARCHIV/ + SIXBIT /A/ + SIXBIT /REAP/ + SIXBIT /R/ + SIXBIT /NO/ + SIXBIT /LINKS/ + SIXBIT /CRDIR/ +NFIGS==.-FIGTB1 + +FIGHLP: ASCIZ\ +INCREM, I Do an Incremental dump +FULL, F Do a Complete dump +LIST, L Generate a listing of files loaded or dumped +MERGE, M Don't load over existing file with the same name +CARE, C Don't load over files not yet backed up +EXPERI, E Don't set has-been-backed-up bits +SORRY, S Go ahead and load over files with newer creation dates +NOASK Don't ask whether a file should be loaded over, assume "no" +DATE Dump only files with creation date greater or equal specified +DATES Dump only files with creation date between two dates specified +ARCHIV, A Declare this dump tape to be Archival. +REAP, R Do a reap after dumping (don't use this, please) +DECIDE, D (Supposedly controls tape number assignment) +NO Don't check incremental dump (one pass instead of two) +LINKS Dump links as well as files +CRDIR Create directories that files are being loaded into + OPTIONS: \ + +FIGTB2: INCREM + INCREM + MRGSW + MRGSW + FULLDMP + FULLDMP + CAREF + CAREF + EXPERM + EXPERM + LSTWHL + LSTWHL + LOSRSW + LOSRSW + NOASK + DECIDF + DECIDF + DATEF + DATESF + ARCHVF + ARCHVF + REAPSW + REAPSW + CKIDMP + DMPLNK + CRDIR +IFN .-FIGTB2-NFIGS, .ERR FIGTB2 NOT SAME LENGTH AS FIGTB1 +;NOTE: ABOVE LOCATIONS ARE MUNGED OVER BY EXECU AND +;THEN SET TO DIFFERENT VALUES THAN JUST WHETHER THE +;USER GAVE THE SWITCH OR NOT, IN SOME CASES. + +;BEGIN EXECUTION OF LOAD OR DUMP OPERATION. +;FIRST STEP IS TO CLEAN UP OPTIONS AND ASK FOR ADDITIONAL INFO. + +EXECU: MOVE A,DMPMOD ;SAVE CRUFT FOR 'CLOAD' COMMAND + MOVEM A,CLOADF + MOVE A,RELOSW + MOVEM A,CLOADF+1 + MOVSI A,-NFIGS + MOVEI B,3 +EXECU0: MOVE C,@FIGTB2(A) + MOVEM C,CLOADF(B) + ADDI B,1 + AOBJN A,EXECU0 +;Make sure the tape is not positioned in the middle of a file +;Also decide whether the first thing read/written should be a tape header + MOVE A,TAPEF ;Tape status left by SETIT + TRNN A,TF%BOT + JRST [ PUSHJ P,SPRF ;Space reverse file + PUSHJ P,SETIT1 ;Get status again + TRNE A,TF%BOT + JRST .+1 ;That moved it to beginning of tape + PUSHJ P,SPFF ;Get to beginning of next file + JRST .+2 ] + SETOM THTPN ;At front of tape, we don't know the number + SKIPE REAPSW + PUSHJ P,REAPCK + SETZM NPLACE + SKIPGE DATESF + SETOM DATEF + SETZM NFTDMP + SKIPGE CDMFL + SETOM FULLDMP ;CDUMP IS A FULL ONE + CLEARM PACKN + SKIPE MICFLG + CLEARM INCREM ;NO INCREMENTAL DUMPS FROM DEC-TAPE + SETZM THTYPE ;DEFAULT TO RANDOM TYPE OF TAPE +; Removed by Alan 11/17/86, who didn't think it was a feature. +; SKIPGE DATEF +; SETOM FULLDMP ;DATES SPECIFIED => DUMP ALL + SKIPGE FULLDMP + SETOM EXPERM ;IF DUMPING ALL, DON'T SET DMPCHK BIT! + SKIPGE DATESF + SKIPE ACLODF + CAIA + PUSHJ P,GETUDT ;GET UPPER DATE + SKIPGE DATEF + SKIPE ACLODF + CAIA + PUSHJ P,GETLDT ;GET LOWER DATE + SKIPGE FULLDMP + AOS THTYPE + SKIPGE INCREM + SOS THTYPE + SKIPGE A,INCREM + SETOM FULLDMP ;AN INCREMENTAL DUMP IS ALWAYS A FULL ONE + SKIPN ACLODF + JRST [ SKIPGE DMPMOD + SKIPL FULLDMP + PUSHJ P,FILGET ;GET FILE NAMES OF FILES TO DUMP OR LOAD + JRST .+1 ] + SKIPE LSTWHL + SKIPE ACLODF + CAIA + PUSHJ P,DEVGET ;GET LISTING DEVICE + SETZM ACLODF + .SUSET [.SSNAME,,USNM] + SKIPN DMPMOD + JRST RETRV0 ;LOAD + SKIPL CDMFL + SKIPE ITAPE + CAIA + CLEARM NTAPES ;COMMAND WAS DUMP ONLY DO THIS IF NOT CDUMP AND TAPE IS REWOUND + SETOM MFDIN + SETOM FLNI + SKIPE CDMFL + JRST EXECU1 + SKIPL FULLDMP + JRST ADUMP2 ;SINGLE FILE DUMP + SETOM DMPMFD ;STARTING FULL OR INCREMENTAL DUMP, SO + SETOM DMPDIR ;DUMP THE MFD AT THE FRONT AND DUMP + JRST ADMP1 ;EACH UFD THAT HAS CHANGED. + +REAPCK: PUSHJ P,CRR + PRINT YOU SPECIFIED REAP + PUSHJ P,CHECK + POPJ P, + +GETUDT: PRINT LATEST DAY - + PUSHJ P,GETDAT + MOVE A,DATE + HLLOM A,DATE1 + POPJ P, + +GETLDT: PRINT EARLIEST DAY - + JRST GETDAT + + SUBTTL CONTINUING A COMPLETE DUMP, GET TAPE AND MFD BACK INTO PHASE + +;TAPE FILE MISSING, DO REEL OVER +EXECU2: PRINT _MAY I REWIND AND RESTART THIS REEL ?? + PUSHJ P,CHECK2 + PUSHJ P,ARWND + PRINT ON THE LAST REEL_ +EXECU1: SKIPGE ITAPE ;REWOUND ??? + JRST SETFNG ;YES + PUSHJ P,TAPEMB + PUSHJ P,SNPLAC + MOVEI A,.BII + HRLM A,NSVOP + OPEN SAVET,NSVOP ;GET .TAPEn; TAPE nnn FILE + JRST EXECU2 + MOVE B,[-LTHBLK-1,,BUF] ;FIND OUT LAST USER DUMPED + .IOT SAVET,B + SETOM A +EXECU3: MOVE B,[-2000,,BUF] +EXECU4: SKIPL A + JRST LOOKSM + .IOT SAVET,B + HLLZS B + SKIPGE B + SETZM A + MOVE C,[-2000,,BUF] + SUB C,B + SETOM D +EXECU5: CAME D,(C) + AOBJN C,EXECU5 + HLRE B,C + SKIPN B + JRST EXECU3 ;COUNT RAN OUT + AOJE B,EXECU6 ;ON BLOCK BOUNDRY? + AOBJN C,.+1 + MOVE B,(C) + MOVEM B,USNM + JRST EXECU5 + +EXECU6: HRROI B,USNM + .IOT SAVET,B + MOVE B,[-1777,,BUF+1] + SETZM BUF + JRST EXECU4 + +LOOKSM: PUSHJ P,SPRF ;BACK OVER TWO FILES + PUSHJ P,SPRF + PUSHJ P,SETIT1 ;Get tape status + TRNN A,TF%BOT ;Unless BOT, + PUSHJ P,SPFF ; Forward one file + PUSHJ P,SETIT + SKIPGE ITAPE ;DID WE BACK UP TO BEGINING OF TAPE ??? + JRST SETFNG ;YES + PUSHJ P,MAGOP ;READ HEADER FOR DIRECTORY NAME + .VALUE ;EOT AFTER BACKSPACING ????? + MOVE A,USNM ;IS DIRECTORY NAME OF FILE ON TAPE THE SAME + CAME A,HSNM ; AS THE ONE WE ARE LOOKING FOR ??? + JRST LOOKSM ;NO + PUSHJ P,FILSKP ;YES, FLUSH TO END OF THIS FILE + MOVE B,USNM ;I.E. END OF LAST DIRECTORY DUMPED ON TAPE + JRST KSUSER + +SETFNG: PUSH P,LPTSW + SETZM LPTSW + PRINT WHAT WAS THE LAST DIRECTORY DUMPED ? + POP P,LPTSW + PUSHJ P,GETSYL + JRST SETFNG + MOVE B,SYM +;HAVING FOUND WHAT DIRECTORY TO CONTINUE DUMPING WITH, ADVANCE +;MFD TO THERE, THEN JOIN REGULAR DUMP CODE +KSUSER: PUSHJ P,MFDN + DIE NO SUCH DIRECTORY + CAME B,USNM + JRST KSUSER + JRST ADMP1 ;GOT IT, START THE DUMP + SUBTTL DUMPING FROM USER-GIVEN FILE LIST + +;RUNS THROUGH ALL FILES IN WORLD, IF THEY MATCH DUMP 'EM +ADUMP2: SETZM STYPE + SETOM MFDIN +NXUFD: PUSHJ P,MFDN ;GET SNAM INTO USNM + JRST DUNG ;NO MORE SNAMES LEFT + MOVN W,LENGTH + HRLZS W ;MAKE AOBJN POINTER TO FILE SPEC LIST +SNMCHK: SKIPN A,FMSNM(W) + JRST UGLY ;ANY SNAME MATCHES, INVESTIGATE + CAMN A,USNM + JRST UGLY ;SOME SNAME MATCHES, INVESTIGATE + AOBJN W,SNMCHK ;CONTINUE CHECKING + JRST NXUFD ;NO MATCH POSSIBLE + +;SNAME MATCHES, RUN THROUGH ALL FILES ON THIS DIRECTORY +UGLY: MOVEI V,0 + SETOM GREATF ;FOR > AND < FILE HACKERY + .SUSET [.SSNAM,,USNM] + SETOM FLNI +NXFIL: PUSHJ P,FNG + JRST EODIRK ;NO MORE FILES IN THIS DIRECTORY + MOVN W,LENGTH + HRLZS W ;AOBJN POINTER TO FILE SPECS LIST + MOVS A,FMDEV(W) + HRLI A,.BII + MOVEM A,TRNI +CMCON: SKIPN D,FMSNM(W) + JRST CMFN1 + CAME D,USNM + JRST NXCOM +CMFN1: SKIPN D,FMFN1(W) + JRST CMFN2 + CAME D,[SIXBIT //] + CAIA + JRST RCMFN1 + SKIPN LNKFLG + MOVEM D,FN1 + SETZM GREATF + JRST CMFN2 + +;SNAME AND FN1 SEEM TO MATCH, THINK ABOUT FN2 +RCMFN1: CAME D,FN1 + JRST NXCOM +CMFN2: SKIPE D,FMFN2(W) + CAMN D,FN2 + JRST DUMPIT + CAME D,[SIXBIT //] + CAIA + JRST NXCOM + SKIPN LNKFLG ;'>' AND '<' FILES DON'T GET OPENED FOR LINKS + MOVEM D,FN2 + SETZM GREATF ;WE FOUND A < OR > + JRST DUMPIT + +NXCOM: AOBJN W,CMCON + JRST NXFIL + +;END OF DIRECTORY +EODIRK: PUSHJ P,FILAPP + SKIPGE APPENF ;ANY FILES DUMPED FOR THIS USER ??? + JRST NXUFD +EODIR3: MOVN W,LENGTH ;YES, MAYBE REMOVE SOME SPECS + HRLZS W +EODIR2: CAMN A,USNM ;IS THIS ENTRY ONE FOR USER JUST DUMPED ? + JRST REMOVE ;YES +EODIR1: AOBJN W,EODIR2 ;NO + JRST NXUFD + +REMOVE: SKIPN FMDUMP(W) + JRST EODIR1 ;DON'T REMOVE SPEC IF NOTHING EVER MATCHED IT + PUSHJ P,FLUSH ;DELETE SPEC + POPJ P, ;NO MORE SPECS LEFT + ADD W,[1,,] + JRST EODIR2 + +;OK, DUMP THE FILE +DUMPIT: SKIPE LNKFLG + JRST AWRITE + .SUSET [.SSNAM,,USNM] ;IF NOT LINK, SEE IF ALREADY DUMPED + OPEN DSKIN,TRNI + JRST NXCOM ;JUST CONTINUE + MOVE A,[DSKIN,,TRNI] + PUSH P,TRNI + .RCHST A, + POP P,TRNI + MOVEI A,0 + MOVE B,FN1 + MOVE C,FN2 +LOOP69: CAML A,V + JRST APPEND + CAME B,BIF(A) + JRST LUP691 + CAMN C,BIF+1(A) + JRST EODIR3 +LUP691: ADDI A,2 + JRST LOOP69 + +APPEND: MOVEM B,BIF(A) + MOVEM C,BIF+1(A) + ADDI V,2 + JRST AWRITE + +;ACTUALLY WRITE OUT THE FILE. +AWRITE: PUSHJ P,ADMP3 + SETOM FMDUMP(W) ;MARK THIS ARG AS HAVING BEEN SATISFIED AT LEAST ONCE + SKIPN FMSNM(W) + JRST NXCOM ;DON'T DELETE ENTRY IF ANY "*" IN IT + SKIPE FMFN1(W) + SKIPN FMFN2(W) + JRST NXCOM + PUSHJ P,FLUSH + POPJ P, + ADD W,[1,,] + SOJA W,NXCOM + +;DONE DUMPING, SEE IF ANY SPECS WEREN'T SATISFIED. +DUNG: MOVN W,LENGTH + HRLZS W +REMOV2: SKIPN FMSNM(W) + JRST REMOV1 ;"*;" + SKIPE FMFN1(W) ;"* *" + SKIPN FMFN2(W) + JRST REMOV1 +REMOV3: AOBJN W,REMOV2 + PRINT _NOT DUMPED:_ + MOVN W,LENGTH + HRLZS W +NOREM1: IRP X,,[SNM,FN1,FN2] + SKIPN A,FM!X(W) + MOVSI A,(SIXBIT /*/) + PSIS A + IFSE X,SNM,[PASC [ASCIZ /;/]] +TERMIN + PUSHJ P,CRR + AOBJN W,NOREM1 + POPJ P, + +REMOV1: SKIPL FMDUMP(W) ;WAS ANYTHING DUMPED FOR THIS SPEC ?? + JRST REMOV3 ;NO + PUSHJ P,FLUSH + POPJ P, + ADD W,[1,,] + JRST REMOV2 + SUBTTL DUMPING ALL FILES (FULL OR INCREMENTAL) + +ADMP1: PUSHJ P,TAPEMB ;GET TAPE NUMBER IF DON'T HAVE YET + PUSHJ P,MFDN ;READ A LOSER NAME FROM M.F.D. + JRST RAT ;DONE + SKIPE LSTWHL ;LIST ? + PUSHJ P,LDMUT1 +ADMPL1: MOVE A,USNM + SKIPGE ITAPE + MOVEM A,FUSNM ;FIRST LOSER DUMPED + .SUSET [.SSNAM,,A] ;SO FNG READS THE CORRECT DIRECTORY +;COME HERE OUT OF END-OF-REEL INTERRUPT +DMPAGN: SETOM FLNI ;RESTART ON NEW REEL + SKIPL FULLDMP + POPJ P, ;THIS PROBABLY RETURNS FROM ADMP3 + ;IN THE CASE OF A GFR OR FILE BY FILE + ;DUMP THAT USES UP THE REEL. CLEARLY + ;THE WRONG THING TO DO, BUT CLOSE. + SETOM DMPUFD + SETOM DMPDIR + .SUSET [.SSNAM,,USNM] + PUSHJ P,ADMP4 ;DUMP THE DIR AND RETURN +;THIS IS WHERE COMPLETE AND INCREMENTAL DUMPS LOOP +ADMP2: PUSHJ P,TAPEMB ;GET TAPE NUMBER IF NEEDED + .SUSET [.SSNAM,,USNM] + PUSHJ P,FNG ;READ ANOTHER FILE NAME + JRST FULNMF ;NO MORE + MOVE A,PACKN + SKIPL DPACK ;RIGHT PACK ? + CAMN A,DPACK + PUSHJ P,ADMP3 ;YES, OR ANY WILL DO, CALL DUMPER + JRST ADMP2 ;NOT RIGHT PACK + +FULNMF: PUSHJ P,FILAPP ;END OF THIS DIRECTORY, FINISH + JRST ADMP1 ;AND GO BACK FOR MORE + +;PRINT LISTING LINE WHEN STARTING A NEW UFD +LDMUT1: PUSHJ P,CRR + PUSHJ P,TAPN ;PRINT SEQUENCE NUMBER + PSIS USNM ;PRINT DIRECTORY NAME + PUSH P,LPTSW + SETZM LPTSW + PUSHJ P,CRR + PSIS USNM ;PRINT JUST DIRECTORY NAME ON CONSOLE + POP P,LPTSW + POPJ P, + +;INCREMENT FILE SEQUENCE NUMBER AND PRINT IT +TAPN: MOVE D,ITAPE + AOS D + PDPT D + POPJ P, + +;DUMP A FILE (FROM EITHER TYPE OF DUMP) +;THIS IS A SUBROUTINE. CALL WITH SNAME SET UP AND NAME IN FN1, FN2 +ADMP3: SKIPE LNKFLG + JRST ADMP4 + OPEN DSKIN,TRNI ;OPEN DISK INPUT + POPJ P, ;FILE DOESN'T SEEM TO EXIST AFTER ALL + .CALL [ SETZ ? 'FILLEN ? MOVEI DSKIN ? SETZM A] ;A GETS NUMBER OF WORDS IN FILE + .LOSE %LSFIL + CAMGE A,[2500.*2000] ; :BUG MUDDLE BEFORE DECREASING THIS CONSTANT! + JRST ADMP4 ;FILE NOT TOO BIG + PUSH P,LPTSW + SETZM LPTSW + PRINT _ + .SUSET [.RSNAME,,A] + PSIS A + PRINT [;] + PSIS FN1 + PSIS FN2 + PRINT [ - FILE IS TOO DAMNED BIG, ] + ;SKIPN GFRFLG ;IF DOING GFR, DUMP ANYWAY, USER CAN QUIT OUT AND DELETE + SKIPGE FULLDMP ; THE FILE IF THAT BECOMES NECESSARY. + JRST [ ;IF DOING INCREMENTAL OR FULL, DON'T DUMP IT + PRINT [NOT DUMPED._] + POP P,LPTSW + POPJ P, ] + PRINT [IT MAY NOT FIT ON TAPE, WILL TRY ANYWAY._] + POP P,LPTSW +ADMP4: MOVEM P,ERRPDP ;SAVE STUFF IN CASE OF REMOTE TAPE ERROR + MOVEM 16,INTAC+16 + MOVEM 17,INTAC+17 + MOVEI 16,INTAC + BLT 16,INTAC+15 + MOVE 16,INTAC+16 + PUSHJ P,TAPEMB + AOSE APPENF ;SKIP IF FIRST FILE THIS DIRECTORY + JRST ADMP5 + PUSHJ P,SNPLAC + SETZM USRUFD +ADMP5: +IFE MCOND DM,[ + SKIPGE ITAPE + PUSHJ P,EXTPCK ; TAPE ALREADY EXIST? +] + .SUSET [.SSNAM,,USNM] ;SO .OPEN DSKIN, LOOKS ON THE CORRECT DIRECTORY + SKIPE MAGOPN ; OPEN YET? + JRST ADMP7 ; YES + SETOM MAGOPN + SKIPL TAPTYP + JRST ADMP6 ;Local tape + PUSHJ P,RMTSTS ;Make sure it's mounted (this also + TRNE A,TF%RDY ; drains queued status) + JRST ADMP7 + DIE OUTPUT TAPE NOT MOUNTED + +ADMP6: OPEN MAGOUT,MAGO ;OPEN MAG TAPE OUTPUT + JRST RET +ADMP7: SETOM EOTFLG + AOSE ITAPE ;BEGINNING OF TAPE ? + JRST LP2A ;NO + PUSH P,LPTSW + SETZM LPTSW + PUSHJ P,GINFO + SKIPG SDONE + JRST LP2B + PRINT THAT'S AN ARCHIV TAPE. + PUSHJ P,CHECK ;ALREADY DELETED THE TAPE FILE FOR IT??? +LP2B: MOVSI A,-1 ;TEST TAPE # BUT NOT REEL # + SKIPE SDONE + TDNN A,STAPEN ;CHECK FOR REUSE OF RECENT TAPE + JRST LP2BB ;THAT WASN'T ABORTED, AND NOT TAPE0 + MOVE A,STDATE + PUSHJ P,SBDTTN ;CONVERT TAPE DATE TO NUMBER OF DAYS + MOVE B,A + .RDATE A, ;CURRENT DATE + PUSHJ P,SBDTTN + ADDI B,30. + CAMLE A,B + JRST LP2BB + PRINT THAT TAPE IS LESS THAN 30 DAYS OLD + PUSHJ P,CHECK +LP2BB: POP P,LPTSW + SETZM NSVTPN+1 ;BOT, START A NEW .TAPEn; TAPE nnn FILE + .SUSET [.SSNAM,,NPLACE] + .FDELE NSVOP ;SO WE DON'T APPEND TO ANY OLD ONE + JFCL + .SUSET [.SSNAM,,USNM] + SETZM SDONE + AOSE A,NTAPES ;IS THIS THE FIRST RUN FOR THIS LOADING? + SOS A,NTAPES ;NO. WE WEREN'T SUPPOSED TO TOUCH NTAPES + HRRM A,THTPN ;REEL NUMBER IN CURRENT DUMP + PUSHJ P,SINFO + .RDATE A, + MOVEM A,THDATE + ;.SUSET [.RSNAM,,E] ;doesn't seem to get used. + JRST LP2C + +EXTPCK: .SUSET [.SSNAM,,NPLACE] + HLRZ A,NSVOP + HRRZS NSVOP .SEE .UAI + .OPEN DSKOUT,NSVOP + JRST EXTPK1 + HRLM A,NSVOP + PUSH P,LPTSW + SETZM LPTSW + PRINT YOU ARE NOT AT THE END OF TAPE. + PUSHJ P,CRR + PRINT YOU WILL DESTROY USEFUL DATA! + POP P,LPTSW + JRST CHECK + +EXTPK1: HRLM A,NSVOP + POPJ P, + +;COMPLETE OR INCREMENTAL DUMP IS, UH, COMPLETE. +;NOTE SIMILARITY OF THIS CODE TO 'FOOB' +RAT: PUSH P,LPTSW ;REPORT THE CRUD TO TTY + SETZM LPTSW + PUSHJ P,GESELL ;SAY WHAT USERS ON THIS REEL + PUSHJ P,CLSOUT ;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE + SKIPE INCREM + SKIPE CKIDMP + JRST RAT2 + SKIPE EXPERM + JRST RAT2 + ;MUST CHECK, AND SET DUMPCHECK BITS + SETOM LUSNM ;SO WE WILL GET LAST USER + PRINT _REWINDING +IFE MCOND DM,[ + MOVN N,NFTDMP ;[SOMEONE SHOULD DOCUMENT THIS] + MOVE B,NFTDMP + SOS B + CAMN B,ITAPE ;IF EQUAL, THEN IT IS THE WHOLE TAPE + JRST RAT1 + PUSHJ P,ASPAC1 + SKIPA +] +RAT1: PUSHJ P,ARWND + PRINT _CHECKING INCREMENTAL DUMP + PUSHJ P,ICHECK + PUSHJ P,ARWND +RAT2: POP P,LPTSW + SKIPN REAPSW ;DO REAP IF ASKED + JRST RET + JRST INCGFR + +;CONVERT SIXBIT DATE IN A TO NUMBER OF DAYS IN A +SBDTTN: CAMN A,[-1] + POPJ P, + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + MOVE B,[440600,,A] + PUSHJ P,SBDTN1 ;YEARS + IMULI C,12.*31. ;EL CHEAPO! + MOVE D,C + PUSHJ P,SBDTN1 ;MONTHS + IMULI C,31. + ADD D,C + PUSHJ P,SBDTN1 ;DAYS + ADD D,C + MOVE A,D + POP P,E + POP P,D + POP P,C + POP P,B + POPJ P, + +;GET TWO SIXBIT CHARS AND CONVERT TO NUMBER IN C +SBDTN1: ILDB E,B + SUBI E,"0 + ILDB C,B + SUBI C,"0 + IMULI E,10. + ADD C,E + POPJ P, + +;HERE'S THE ROUTINE THAT ACTUALLY, FINALLY, WRITES ON THE TAPE. +;HERE IF NEED A TAPE HEADER FIRST (WE'RE AT FRONT OF TAPE) +LP2C: MOVE A,[THBLK,,LISTBF] ;LISTBF IS BUFFER FOR OUTPUT TO + ADD A,USRUFD ;THE .TAPEn; TAPE nnn FILE + BLT A,LISTBF+LTHBLK-1(USRUFD) + MOVE A,[-3,,0] + ADDI USRUFD,LTHBLK + MOVEM A,LISTBF(USRUFD) + AOS USRUFD + MOVE A,[-LTHBLK,,THBLK] ;OUTPUT TAPE-HEADER + PUSHJ P,MAGWRI +;HERE IF NOT AT FRONT OF TAPE +LP2A: AOSN DMPDIR + JRST DIRDMP ;DON'T DUMP A FILE, DUMP A DIR INSTEAD. + PUSHJ P,DFHBLK ; Set defaults in file header + MOVE A,USNM ;SET UP FILE HEADER + MOVEM A,HSNM + MOVE A,FN1 + MOVEM A,HFN1 + MOVE A,FN2 + MOVEM A,HFN2 + MOVE A,PACKN + MOVEM A,HPKN + MOVE A,[SETZ] + MOVEM A,HDATE ;CREATION DATE OF LINK IS 400000,,0 + MOVEI A,3 + MOVEM A,HLEN ; Length of link is always 3 + SKIPE LNKFLG + JRST LP3A + .CALL RHDATS + PUSHJ P,DFHDTS ; So the dates are unknown + SKIPE A,RFDATE ; Except if we are about to set the date + HLLM A,HRDATE ; below, then use that. + .CALL RHLEN + SETOM HLEN ; So the length is unknown +LP3A: MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER + PUSHJ P,MAGWRI + MOVE A,HBLK+2 + MOVEM A,LISTBF(USRUFD) + MOVE A,HBLK+3 + MOVEM A,LISTBF+1(USRUFD) + MOVE A,HBLK+5 + MOVEM A,LISTBF+2(USRUFD) + ADDI USRUFD,3 + SKIPE LSTWHL + PUSHJ P,LOUSY ;GENERATE LISTING LINE + JFCL + SKIPE LNKFLG + JRST LP4A + SKIPN RFDATE + JRST LP + .CALL SRFDAT + JFCL +LP: MOVE A,[-2000,,BUF] ;OUTPUT THE FILE + .IOT DSKIN,A + HRLOI B,-BUF-1(A) + EQVI B,BUF ;AOBJN POINTER TO STUFF ACTUALLY READ + SKIPGE A + .CLOSE DSKIN, + JUMPGE B,LP1 + EXCH A,B + PUSHJ P,MAGWRI + JUMPGE B,LP ;MORE TO DO ? +LP1: SKIPN CKIDMP + JRST LP1A + SKIPN MICFLG ;DON'T BOTHER CHECKING, SET DUMPCHECK + SKIPE EXPERM ;BITS NOW. + JRST LP1A + OPEN DSKIN,TRNI ;RE-OPEN SINCE CLOSED BY EOF + JRST LP1A + .CALL SRFDAT + JFCL + MOVE A,[400000,,DSKIN] + .DMPCH A, ;SET DUMP CHARACTER SO WONT BE + .CLOSE DSKIN, ; INCREMENTALLY DUMPED AGAIN. +LP1A: PUSHJ P,AEOF ;WRITE EOF MARK ON TAPE + MOVE A,USNM + MOVEM A,LUSNM ;LAST LOSER DUMPED + AOS NFTDMP + POPJ P, ;RETURN FROM ADMP3 + +LP4A: MOVE A,[-3,,LNKNM1] ;DUMP A LINK AS A 3 WORD FILE + PUSHJ P,MAGWRI ; LKNM1,LKNM2,SNAM + JRST LP1A + +;HERE IF DUMPING A DIRECTORY RATHER THAN A FILE +DIRDMP: .IOPUSH DSKIN, ;PROTECT FILE ALREADY OPEN MAYBE + AOSN DMPMFD + PUSHJ P,MFDDMP + AOSN DMPUFD + PUSHJ P,UFDDMP + .IOPOP DSKIN, + SKIPL FULLDMP + JRST LP2A ;NOT A FULL DUMP, GO BACK + POPJ P, ;RETURN TO ADMP2 + +MFDDMP: HRRI A,.BII + HRLM A,MFO + .OPEN DSKIN,MFO + POPJ P, + MOVE A,[-2000,,MFDBUF] + .IOT DSKIN,A + PUSHJ P,DFHBLK ; Set defaults in HBLK + MOVE A,USNM + MOVEM A,HSNM + MOVE A,MFO+1 + MOVEM A,HFN1 + MOVE A,MFO+2 + MOVEM A,HFN2 + .CALL RQDATE + JFCL + MOVEI A,2000 ; MFD is always 2000 words long + MOVEM A,HLEN + MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER + PUSHJ P,MAGWRI + MOVE A,HBLK+2 + MOVEM A,LISTBF(USRUFD) + MOVE A,HBLK+3 + MOVEM A,LISTBF+1(USRUFD) + MOVE A,HBLK+5 + MOVEM A,LISTBF+2(USRUFD) + ADDI USRUFD,3 + SKIPE LSTWHL + PUSHJ P,LOUSY + JFCL + AOS ITAPE + MOVE A,[-2000,,MFDBUF] + PUSHJ P,MAGWRI + PUSHJ P,AEOF + AOS NFTDMP + POPJ P, + +UFDDMP: HRRI A,.BII + HRLM A,FNO + .OPEN DSKIN,FNO + POPJ P, + MOVE A,[-2000,,UFDBUF] + .IOT DSKIN,A + PUSHJ P,DFHBLK ; Set defaults in HBLK + MOVE A,USNM + MOVEM A,HSNM + MOVE A,FNO+1 + MOVEM A,HFN1 + MOVE A,FNO+2 + MOVEM A,HFN2 + .CALL RQDATE + JFCL + MOVE A,UDESCP+UFDBUF ; Calculate how many words we're actually + ADDI A,5 ; going to dump out below. + IDIVI A,6 + ADDI A,UDDESC+2000 + SUB A,UDNAMP+UFDBUF + MOVEM A,HLEN + MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER + PUSHJ P,MAGWRI + MOVE A,HBLK+2 + MOVEM A,LISTBF(USRUFD) + MOVE A,HBLK+3 + MOVEM A,LISTBF+1(USRUFD) + MOVE A,HBLK+5 + MOVEM A,LISTBF+2(USRUFD) + ADDI USRUFD,3 + SKIPE LSTWHL + PUSHJ P,LOUSY + JFCL + MOVE A,UDESCP+UFDBUF ;PACK DIRECTORY BY NOT DUMPING FREE AREA + ADDI A,5 + IDIVI A,6 ;ROUND UP TO NEXT HIGHER WORD + ADDI A,UDDESC ;DUMP HEADER AREA TOO + MOVNS A + HRLS A + HRRI A,UFDBUF ;DUMP OUT DESC AREA + PUSHJ P,MAGWRI + MOVE A,UDNAMP+UFDBUF + SUBI A,2000 + HRLS A + HRR A,UDNAMP+UFDBUF + ADDI A,UFDBUF ;DUMP OUT NAME AREA + PUSHJ P,MAGWRI + PUSHJ P,AEOF + AOS NFTDMP + POPJ P, + +;CALL HERE AFTER DUMPING ALL THE FILES IN A SINGLE DIRECTORY +;UPDATE .TAPEn; TAPE nnn FILE (TAPE DIRECTORY) +FILAPP: SKIPGE APPENF + POPJ P, ;NOTHING WAS DUMPED FOR THIS USER + MOVEI A,.BII + HRLM A,NSVOP + .SUSET [.SSNAM,,NPLACE] + .OPEN SAVET,NSVOP + JRST KARILY ;FIRST TIME THROUGH + PUSHJ P,ACCESS + MOVEI A,100007 ;WRITE-OVER MODE + HRLM A,NSVOP +FILAP0: OPEN SAVET,NSVOP + JRST [ PUSH P,LPTSW + SETZM LPTSW + PRINT [TYPE ANY CHARACTER TO TRY AGAIN] ;MAYBE SOMEONE HAS IT OPEN + PUSHJ P,TYI + PUSHJ P,CRR + POP P,LPTSW + JRST FILAP0 ] ;KEEP TRYING UNTIL IT WORKS, DON'T PUNT THE WHOLE DUMP + .ACCESS SAVET,B ;WE'RE ABOUT TO APPEND "USER" UFD" ONTO "TAPE XXX" +FILAP1: MOVE A,[-1,,[0]] + .IOT SAVET,A ;CREATE SNAME ENTRY + HRROI A,USNM + .IOT SAVET,A +FLY: MOVNS USRUFD + HRLS USRUFD + HRRI USRUFD,LISTBF + .IOT SAVET,USRUFD + .CLOSE SAVET, + POPJ P, + +;GOTTA CREATE THE TAPE DIRECTORY +KARILY: MOVEI A,.BIO + HRLM A,NSVOP + OPEN SAVET,NSVOP + JRST RET + MOVE A,[-LTHBLK-1,,LISTBF] ;PUT HEADER + .IOT SAVET,A + MOVE A,[-1,,[0]] ;THEN PUT CHANGE-SNAME TO THIS DIR + .IOT SAVET,A + HRROI A,USNM + .IOT SAVET,A + SUBI USRUFD,LTHBLK+1 ;THEN DUMP OUT THIS DIR'S INFO + MOVNS USRUFD + HRLS USRUFD + HRRI USRUFD,LISTBF+LTHBLK+1 + .IOT SAVET,USRUFD + .CLOSE SAVET, + POPJ P, + +ACCESS: MOVEI B,0 ;ACCUMULATED ACCESS POINTER +MORCRF: MOVE A,[-2000,,BUF] ;THIS ROUTINE ACCESSES TO THE END OF THE FILE + .IOT SAVET,A ;THIS READING ONLY TO GET POINTER + HLRE C,A + ADDI B,2000(C) ;INCREMENT ACCESS POINTER + JUMPGE A,MORCRF ;CONTINUE READING + POPJ P, + +;DETERMINE INTELLIGENTLY WHETHER OR NOT TO ASK FOR +;TAPE AND REEL NUMBER +;AND ASK WHAT IS NECESSARY +TAPEMB: SKIPL THTPN + JRST ADMPK1 ;WE ALREADY KNOW WHAT TAPE THIS IS +ADMPK: PUSHJ P,TAPGET + MOVEM SYM,NSVTPN + SKIPGE CDMFL ;DON'T ASK REEL # FOR NOT CDUMP + SKIPL NTAPES ;DON'T ASK REEL # IF YOU KNOW IT + JRST ADMPK1 ;WE ALREADY KNOW WHAT REEL THIS IS + PUSH P,LPTSW + SETZM LPTSW + PRINT REEL = + POP P,LPTSW + PUSHJ P,GETSYL + JRST .-1 + HRRM N,THTPN + MOVEM N,NTAPES +ADMPK1: POPJ P, + + + SUBTTL DUMP A FILE TO THE FILECOMPUTER +;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP AND NAME IN FN1, FN2 + +FCDMP: SKIPE LNKFLG ;IF INPUT FILE IS A LINK + POPJ P, ;DONT BOTHER WITH IT HERE. + .CALL [ SETZ ? SIXBIT/OPEN/ ? [.UIO,,DSKIN] + GFRDEV ? FN1 ? FN2 ? 400000,,SNAME] ;TRY TO OPEN INPUT FILE. + POPJ P, ;OH,WELL. +FCDMP0: .CALL [ SETZ ? SIXBIT/OPEN/ ;PROBE FOR DIRECTORY ON FC: + [.UAI,,DSKOUT] + [SIXBIT /FC/] + [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] + 400000,,SNAME] + JRST [ .CLOSE DSKOUT + PUSHJ P,CFCDIR ;IF MISSING, TRY TO CREATE IT. + PUSHJ P,FCDDLS ; UMMM, GEE. IT DIDNT WORK? + JRST FCDMP1] ; YOW! NOW WE CAN HAVE FUN! + .CLOSE DSKOUT +FCDMP1: .CALL [ SETZ ? SIXBIT/OPEN/ ;OPEN OUTPUT FILE. + [.UIO,,DSKOUT] + [SIXBIT /FC/] ? FN1 ? FN2 ? 400000,,SNAME] + JRST FCDLOS + PUSHJ P,FCDMP4 ;GET PAGES FOR THE BUFFER. +FCDMPI: MOVE U,[444400,,BUFFER] ;SETUP FOR FULL WORD TRANSFERS. + MOVEI W,BUFSIZ*PAGSIZ + .CALL [ SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,W] + .LOSE %LSFIL + MOVEI V,BUFSIZ*PAGSIZ + SUB V,W ;HOW MUCH MORE TO GO? + JUMPE V,FCDMPZ + MOVE U,[444400,,BUFFER] + MOVEI W,BUFSIZ*PAGSIZ + .CALL [ SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,V] + .LOSE %LSFIL + JRST FCDMPI +FCDMPZ: .CLOSE DSKOUT, ;CLEAN UP WHEN DONE. +FCDMP3: .CLOSE DSKIN, + POPJ P, + +FCDMP4: SKIPE FCDMAP ;IF WE ALREADY GOT SOME BUFFER PAGES + POPJ P, ;DONT GET 'EM TWICE! + MOVE X,[-BUFSIZ,,/PAGSIZ] + .CALL [ SETZ ? SIXBIT/CORBLK/ + %CLIMM,,%CBNDR\%CBNDW + %CLIMM,,%JSELF + X + 400000+%CLIMM,,%JSNEW] + .LOSE %LSSYS + SETOM FCDMAP + POPJ P, + +FCDDLS: PUSH P,LPTSW ;WARN OF LOSSAGE VIA THE TTY. + SETZM LPTSW + PRINT [FILECOMPUTER DIRECTORY CREATION FAILED - MAYBE FC IS DOWN?] + POP P,LPTSW + POPJ P, ;AND PUNT OUT. + + +FCDLOS: PUSH P,LPTSW ;WARN OF LOSSAGE VIA THE TTY. + SETZM LPTSW + PRTFNS + PRINT [NOT COPIED TO FILECOMPUTER.] + POP P,LPTSW + POPJ P, ;AND PUNT OUT. + + SUBTTL CREATE A USER DIRECTORY ON THE FC: FILECOMPUTER DEVICE +;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP. +;SKIPS IF SUCCESSFUL. + +CFCDIR: .CALL [ SETZ ? SIXBIT/OPEN/ + [.UIO,,DSKOUT] + [SIXBIT/FC/] + [SIXBIT /..NEW./] + [SIXBIT /(UDIR)/] + SNAME + 400000+%CLERR,,X ] + JFCL + CAIN X,%ENSFL ;IF WE GOT AN FNF ERROR + AOS (P) ;WE WON. + POPJ P, ;OTHERWISE WE LOSE SOMEHOW + + SUBTTL GRIM FILE REAPER + +;FIRST, PROCESS OPTIONS LIKE 'LOOP' +AGFR: SETOM THTPN + MOVSI A,-NGFRSW + SKIPGE GFRTB2(A) + CLEARM @GFRTB2(A) ;IF INSTRUCTION IS SETOM, CLEAR IT + AOBJN A,.-2 + SETZM GFRPNM ;START WITH NO PACKS TO REAP OFF OF + SETZM GFRDEV ;DEFAULT IS TO WRITE TO TAPE + CAIN TER,15 + JRST RET ;NO OPTIONS? DO NOTHING. +GFRLP1: PUSHJ P,TYI + CAIN A,"? + JRST GFRPHL ;GIVE INFO ON OPTIONS AVAILABLE + PUSHJ P,GETSL1 + POPJ P, ;OVER-RUBOUT? DO NOTHING. + PUSHJ P,GFRSPT + CAIN TER,15 + JRST GFREXC + JRST GFRLP1 + +GFRSPT: JUMPE SYM,CPOPJ + MOVSI A,-NGFRSW + CAMN SYM,GFRTB1(A) + JRST GFRSPD + AOBJN A,.-2 + SUB P,[1,,1] ;BAD OPTION, IGNORE + PRINT ? + PSIS SYM + PUSHJ P,TYOS + PRINT IGNORED + PUSHJ P,TYOS + JRST GFRLP1 + +GFRSPD: CAMN SYM,[SIXBIT /FC/] + JRST FCNONE +GFRSPX: XCT GFRTB2(A) ;DO OPTION AS SPECIFIED + POPJ P, + +GFRPHL: PASC GFRHLP ;GIVE OPTIONS AND DESCRIPTION + JRST GFRLP1 + +; COME HERE TO SEE IF THIS MACHINE HAS A FILECOMPUTER. +; THIS IS SORT OF BOGUS, BUT I DIDNT WANT TO CONDITIONALIZE THE SOURCE. +FCNONE: .CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ] + .LOSE %LSSYS + CAMN A,[SIXBIT \AIKA\] ;IF WE ARE ON THE AI-KA MACHINE + JRST GFRSPX ;WE CAN DO FILECOMPUTER THINGS. + PUSH P,LPTSW ;ELSE COMPLAIN. + SETZM LPTSW + PRINT [THIS MACHINE DOESN'T HAVE A FILECOMPUTER - IGNORING FC OPTION.] + POP P,LPTSW + POPJ P, + + + ;IF YOU UPDATE THIS TABLE, ALSO UPDATE GFRTB2 AND GFRHLP (ALSO ON THIS PAGE) +GFRTB1: SIXBIT /H/ ;HISTOGRAM + SIXBIT /L/ ;LIST + SIXBIT /DUMP/ ;DUMP + SIXBIT /DELETE/ ;DELETE + SIXBIT /DATE/ ;ENTER DATE + SIXBIT /BLOCKS/ ;GET X BLOCKS + SIXBIT /EVERY/ ;ALLOW NO SPECIAL DIRECTORIES + SIXBIT /CREATE/ ;USE CREATION DATE INSTEAD OF REF DATE + SIXBIT /QUOTA/ ;ENFORCE QUOTA + SIXBIT /ALLOC/ ;REAP ALLOCATED DIRS TOO + SIXBIT /FROM/ ;FROM DEVICE + SIXBIT /TO/ ;TO DEVICE + SIXBIT /ONLY/ ;ONLY FROM SPECIFIED DEVICE + SIXBIT /DISK/ ;DUMP TO SECONDARY DISK INSTEAD OF TAPE + SIXBIT /SECOND/ ;REAP SECONDARY DISK ALSO + SIXBIT /FC/ ;REAP TO BOTH FC DEVICE AND TO TAPE +NGFRSW==.-GFRTB1 + +GFRHLP: ASCIZ\ +H MAKE HISTOGRAM OF BLOCKS FREED VERSUS DATE +L LIST HISTOGRAM AND/OR FILES REAPED +DUMP DUMP REAPED FILES ONTO TAPE +DELETE DELETE REAPED FILES (AFTER DUMPING) +TO dev DUMP TO DISK DEVICE dev (E.G. SECOND) INSTEAD OF TAPE +DATE ENTER DATE OF OLDEST FILE TO RETAIN +BLOCKS ENTER NUMBER OF BLOCKS TO BE OBTAINED +CREATE USE CREATION DATE INSTEAD OF REFERENCE DATE +QUOTA ENFORCE DIRECTORY QUOTAS +ALLOC REAP ALLOCATED DIRS TOO +EVERY ALLOW NO SPECIAL DIRECTORIES (DON'T USE THIS, PLEASE!) +FROM dev REAP OFF OF DEVICE dev (E.G. SECOND) AS WELL AS MAIN DISK. +ONLY REAP ONLY FROM SPECIFIED DEVICE, NOT MAIN DISK. +DISK DUMP TO SECONDARY DISK INSTEAD OF TAPE + (THIS IS AN OBSOLETE FORM FOR "TO SECOND") +SECOND REAP SECONDARY DISK ALSO + (THIS IS AN OBSOLETE FORM FOR "FROM SECOND") +FC REAP FILES ONTO BOTH TAPE AND THE FILECOMPUTER. +_GFR \ + +GFRTB2: SETOM GFRHSW + SETOM GFRLST + SETOM GFRDMS + SETOM GFRDES + SETOM GFRDAS + SETOM GFRBLS + SETOM GFREVR + SETOM GFRCRE + SETOM GFRQUO + SETOM GFRALO + PUSHJ P,GFPFRM + PUSHJ P,GFPTO + SETOM GFRONL + PUSHJ P,GFPDSK + PUSHJ P,GFPSEC + SETOM FCREAP +IFN .-GFRTB2-NGFRSW, .ERR GFRTB2 DISAGREES WITH GFRTB1 + +GFRHSW: 0 ;HISTOGRAM SWITCH +GFRDMS: 0 ;DUMP SWITCH +GFRDES: 0 ;DELETE SWITCH +GFRDAS: 0 ;DATE SWITCH +GFRBLS: 0 ;BLOCKS SWITCH +GFRLST: 0 ;LIST SWITCH +GFRNBK: 0 ;NUMBER OF BLOCKS DESIRED +GFRNBG: 0 ;NUMBER OF BLOCKS GOTTEN +GFREVR: 0 ;NO SPECIAL DIR SWITCH (BE CAREFUL WITH THIS!!!!) +GFRCRE: 0 ;CREATION DATE SWITCH +GFRQUO: 0 ;HACK QUOTA +GFRALO: 0 ;REAP ALLOCATED DIRS TOO +GFRDEV: 0 ;DEVICE WRITING TO (0 MEANS TAPE) +GFRPNM: 0 ;PACK NUMBER MASK (1 MEANS OK TO REAP FROM) +GFRONL: 0 ;ONLY FROM SPECIFIED DEVICE, NOT PRIMARY PACKS +GFRJST: 0 ;DISCRIMINATE AGAINST CERTAIN DIRECTORIES +FCREAP: 0 ;FC DEVICE SWITCH + +GFPDSK: MOVE SYM,['SECOND] + PUSHJ P,GFPDV1 +GFPTO: PUSHJ P,GFPDEV + MOVEM SYM,GFRDEV + POPJ P, + +GFPSEC: MOVE SYM,['SECOND] + PUSHJ P,GFPDV1 +GFPFRM: PUSHJ P,GFPDEV + IORM B,GFRPNM + POPJ P, + +;RETURN WITH SIXBIT DEVICE IN SYM AND BIT MASK OF PACK NUMBERS IN B +GFPDEV: PRINT [DEVICE=] + PUSHJ P,GETSYL + JRST RET + CAIA +GFPDV1: AOS (P) + MOVEI B,0 + MOVSI A,-NQS +GFPDV2: CAME SYM,QRESRV(A) + AOBJN A,.-1 + JUMPGE A,GFPDV3 + MOVEI C,1 + LSH C,@QPKID(A) + IOR B,C + AOBJN A,GFPDV2 +GFPDV3: JUMPN B,CPOPJ + PASC [ASCIZ/? NO SUCH PACK MOUNTED/] + JRST RET + +;ENTRY FROM MAIN DUMP TO ALSO DO A REAP +INCGFR: SETOM GFRFLG + MOVSI A,-NGFRSW + SKIPGE GFRTB2(A) ;CLEAR ALL ARGUMENTS EXCEPT GFRQUO AND LIST IF WAS SET + CLEARM @GFRTB2(A) ;IF INSTRUCTION IS SETOM, CLEAR IT + AOBJN A,.-2 + MOVSI A,-NFIGS + CLEARM @FIGTB2(A) + AOBJN A,.-1 + SETOM GFRQUO + SETOM GFRDMS ;SET DUMP SWITCH + SETOM GFRDES ;SET DELETE SWITCH + SETOM MFDIN + SKIPE LSTWHL + SETOM GFRLST + JRST GFREX1 + +;GFR'S VERSION OF 'EXECU' - MASSAGE OPTIONS AND INITIALIZE +GFREXC: MOVE A,PRIMSK ;ALSO REAP FROM PRIMARY PACKS + SKIPN GFRONL + IORM A,GFRPNM + SKIPN GFRPNM + DIE WHAT PACKS DO YOU WANT ME TO REAP FROM + SKIPE GFRDAS + CLEARM GFRBLS ;CAN'T DO BOTH DATES AND BLOCKS + SKIPN GFRDEV ;REAPING TO SECONDARY DISK + JRST GFRXC1 + SETZM GFRDES + SETZM GFRDMS +GFRXC1: SKIPE GFRDES + PUSHJ P,GFRDCK ;DELETE CHECK + SKIPE GFRBLS + PUSHJ P,GFRGNB ;GET NUMBER OF BLOCKS + SETZM GFRNBG + SKIPE GFRDAS + PUSHJ P,GETDAT ;GET DATES + SKIPE GFRLST + PUSHJ P,DEVGET ;GET LISTING DEVICE + .SUSET [.SSNAME,,USNM] + SKIPE GFRHSW + PUSHJ P,GFRPHI ;COMPUTE HISTOGRAM, MAYBE PRINT IT + SKIPE GFRBLS + PUSHJ P,GFRGBD ;GET DATE ASSOCIATED WITH NEEDED NUMBER OF BLOCKS + SKIPN GFRDAS + SKIPE GFRBLS + JRST GFREX6 + SKIPN GFRQUO + JRST RET ;NO ACTUAL REAPING TO BE DONE, PROBABLY + ; JUST WANTED TO SEE HISTOGRAM + ;*DROPS IN +GFREX6: SKIPE GFRDMS ;IF DUMPING, + PUSHJ P,MBOCF ;GET TO BEGINNING OF CURRENT FILE ON TAPE. + SETOM GFRFLG + SETOM MFDIN + JRST GFREX1 + +MBOCF: PUSHJ P,SPRF ;BEGINNING OF CURRENT FILE + PUSHJ P,SETIT1 ;Get tape status + TRNN A,TF%BOT ;Unless BOT, + PUSHJ P,SPFF ; Forward one file + PUSHJ P,SETIT + POPJ P, + +GETDAT: PRINT ENTER DATE (YY/MM/DD) + PUSHJ P,GETDT + CAIGE N,100. + CAIGE N,1. + JRST GETDAT ;BAD YEAR + DPB N,[330700,,DATE] + PUSHJ P,GETDT + CAIGE N,13. + CAIGE N,1. + JRST GETDAT ;BAD MONTH + DPB N,[270400,,DATE] + PUSHJ P,GETSYL + JRST GETDAT ;OVER RUBOUT ON DAY + CAIGE N,32. + CAIGE N,1. + JRST GETDAT ;BAD DAY + DPB N,[220500,,DATE] + POPJ P, + +GETDT: SETZM N ;GET SYLLABLE OF DATE +GETDT1: PUSHJ P,TYI + CAIN A,40 ;SPACE + POPJ P, + CAIN A,177 ;CAN'T HACK RUBOUT, START OVER + JRST [ SUB P,[1,,1] ? JRST GETDAT ] + CAIN A,"/ + POPJ P, ;SLASH TERMINATES DATE SYLLABLES + SUBI A,"0 + IMULI N,10. + ADD N,A + JRST GETDT1 + +GFRGBD: SKIPN GFRHSW ;COMPUTE WHAT DATE TO REAP BACK TO + PUSHJ P,GFRHIS ; TO GET DESIRED NUMBER OF BLOCKS + MOVE B,[-LGFRBLK,,GFRBLK] +GFRBD1: HLRZ A,(B) + CAML A,GFRNBK + JRST GFRBD2 + AOBJN B,GFRBD1 + PRINT YOU ASKED FOR THE WHOLE DISK + JRST RET + +GFRBD2: HRRZS B + PUSHJ P,CRR + PUSHJ P,GFROFI + MOVEM A,DATE + PRINT DATE FOR GFR IS + PUSHJ P,GFRPDT + PUSHJ P,CRR + POPJ P, + +GFRGNB: PRINT NUMBER OF BLOCKS DESIRED ? + PUSHJ P,GETSYL + JRST GFRGNB + JUMPL N,GFRGNB + MOVEM N,GFRNBK + POPJ P, + +;LOOP OVER ALL FILES +GFREX1: PUSHJ P,MFDN ;GET NEXT DIRECTORY + JRST GFRFIN ;DONE + PUSHJ P,GFRUCK ;SEE IF SPECIAL DIRECTORY THAT + JRST GFREX1 ; SHOULDN'T GET REAPED + .SUSET [.SSNAM,,USNM] + SETOM GFRFQ + SETOM FLNI +GFREX2: SKIPN GFRBLS ;IF USER SAID BLOCKS, STOP WHEN GOT THAT MANY + JRST GFRX2A + MOVE A,GFRNBG + CAML A,GFRNBK + JRST GFRFIN +GFRX2A: PUSHJ P,FNG ;GET NEXT FILE IN THIS DIRECTORY + JRST GFREX3 ; SORTED BY DECREASING DESIRE TO REAP. + SKIPN GFRQUO ;IF ENFORCING QUOTAS, + JRST GFREX4 + MOVE A,BLOCKS ;SEE IF OVER QUOTA + CAMG A,QUOTA + JRST GFREX3 + AOSE GFRFQ + JRST GFREX5 + SKIPN GFRLST + JRST GFREX5 + PUSHJ P,CRR + PUSHJ P,CRR + PSIS USNM + PUSHJ P,TYOS + PRINT QUOTA = + PUSHJ P,TYOS + PDPT QUOTA + PUSHJ P,TYOS + PRINT BLOCKS = + PUSHJ P,TYOS + PDPT BLOCKS + PUSHJ P,CRR + JRST GFREX5 + +GFREX4: SKIPN A,RFDATE + JRST GFREX2 + CAMLE A,DATE + JRST GFREX2 + JRST GFREX5 + +;END OF DIRECTORY +GFREX3: SKIPE GFRDMS + PUSHJ P,FILAPP ;APPEND USERUFD FILE + JRST GFREX1 + +;'DELETE' OPTION GIVEN, SEE IF SHE REALLY MEANS IT +GFRDCK: PRINT YOU SPECIFIED DELETE, + PUSHJ P,CHECK + SKIPE GFRDMS + POPJ P, + PRINT YOU DID NOT SPECIFY DUMP, + PUSHJ P,CHECK + PRINT WHAT TAPE DID YOU DUMP THESE FILES ON? + PUSHJ P,TAPGET + POPJ P, + +;GENERATE LISTING LINE FOR FILE BEING REAPED. +GFRLIS: PUSHJ P,CRR + PSIS USNM + PUSHJ P,TYOS + PSIS FN1 + PUSHJ P,TYOS + PSIS FN2 + PUSHJ P,TYOS + MOVE A,RFDATE + PUSHJ P,GFRPDT + PUSHJ P,TYOS + PDPT FLENTH + POPJ P, + +GFRFIN: SKIPE GFRDMS ;IF DELETING, + PUSHJ P,GESELL ;UPDATE SYSENG;MACRO TAPES. +GFRNUT: SETZM LPTSW + PUSHJ P,CRR + MOVE A,GFRNBG + PUSHJ P,DPT + PRINT [ BLOCKS REAPED.] + JRST RET + +;THIS ONE IS GETTING REAPED +GFREX5: MOVE A,BLOCKS ;COMPUTE BLOCKS SAVED + SUB A,FLENTH + MOVEM A,BLOCKS + SKIPE GFRLST + PUSHJ P,GFRLIS ;LIST + SKIPE GFRDMS + PUSHJ P,ADMP3 ;DUMP ONTO TAPE + SKIPE FCREAP ;MAYBE DUMP ONTO FC DEVICE ALSO + PUSHJ P,FCDMP + SKIPE GFRDES + PUSHJ P,GFRDEL ; THEN DELETE THE FILE. + SKIPN GFRDEV + JRST GFREX2 + HRLZI A,.BII ;DUMP ONTO SECONDARY DISK + HLLM A,TRNI + OPEN DSKIN,TRNI + JRST GFREX2 ;FILE BEEN DELETED + .CALL [ SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT] + GFRDEV ? [SIXBIT/_DUMP_/] ? SETZ ['OUTPUT]] + JRST [ PUSH P,LPTSW + SETZM LPTSW + PRINT [CAN'T OUTPUT TO ] + PSIS GFRDEV + PRINT [: ] + .SUSET [.RSNAME,,A] + PSIS A + PRINT [; _DUMP_ OUTPUT - ] + PUSHJ P,OPINFL + PUSHJ P,CRR + POP P,LPTSW + .CLOSE DSKIN, + JRST GFREX2 ] + .CALL RDATE + JFCL + .CALL SDATE + JFCL + .CALL RRDATE + JFCL + .CALL SRDT + JFCL + LDB A,[230100,,UNRNDW] + .CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A] + JFCL + LDB A,[430100,,UNRNDW] + .CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A] + JFCL + .CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM A] + JFCL + .CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A] + JFCL +GFRDS1: MOVE A,[-2000,,BUF] ;HAVING GOT NEW FILE READY, COPY OVER + .IOT DSKIN,A + HRLOI B,-BUF-1(A) + EQVI B,BUF + SKIPGE B + .IOT DSKOUT,B + JUMPGE A,GFRDS1 + .CLOSE DSKIN, + .CALL [ SETZ ? 'RENMWO ? MOVEI DSKOUT ? FN1 ? SETZ FN2 ] + JRST [ PUSH P,LPTSW + SETZM LPTSW + PRINT [CAN'T RENMWO ] + PSIS GFRDEV + PRINT [: ] + .SUSET [.RSNAME,,A] + PSIS A + PRINT [; ] + PSIS FN1 + PRINT [ ] + PSIS FN2 + PRINT [ - ] + PUSHJ P,OPINFL + PUSHJ P,CRR + POP P,LPTSW + JRST .+1 ] + .CLOSE DSKOUT, + MOVE A,FLENTH + ADDM A,GFRNBG + JRST GFREX2 + +;DELETE REAPED FILE BY REPLACING IT WITH A LINK TO BACKUP; TAPE nnn +GFRDEL: MOVE A,FN1 + MOVEM A,GFRLNK+1 + MOVE A,FN2 + MOVEM A,GFRLNK+2 + MOVSI A,.BII + HLLM A,TRNI + OPEN DSKIN,TRNI ;OPEN FILE BEING DELETED (TO GET CREATION DATE) + POPJ P, + .CALL RDATE ;FDATE GETS CREATION DATE + .LOSE %LSFIL + .CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM AUTHOR] + SETZM AUTHOR + .CALL [ SETZ ? 'DELEWO ? SETZI DSKIN ] + .LOSE %LSFIL + .CLOSE DSKIN, ;OLD FILE VANISHES + MOVE A,FLENTH + ADDM A,GFRNBG + OPEN DSKOUT,GFRLNK ;MAKE THE LINK + POPJ P, ;FOO, SHOULDN'T GET DIR FULL + MOVSI A,20+.BII ;OPEN UP THE LINK AGAIN + HLLM A,TRNI + OPEN DSKOUT,TRNI + POPJ P, ;FOO? + .CALL SDATE ;SET CREATION DATE TO FDATE + .LOSE %LSFIL + .CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ AUTHOR] + JFCL ;ALSO TRY TO PRESERVE AUTHOR + .CLOSE DSKOUT, + POPJ P, + +GFRLNK: 200000,,(SIXBIT/DSK/) ;OPEN COMMAND 2 = MLINK + 0 ;FN1 + 0 ;FN2 + SIXBIT /TAPE/ + 0 ;TAPE NUMBER FROM TAPGET + SIXBIT /BACKUP/ ;SNAME FOR LINK + +;COMPUTE HISTOGRAM OF DATE VERSUS NUMBER OF BLOCKS SAVED +;IF FILES OLDER THAN THAT ARE REAPED. +GFRPHI: PUSHJ P,GFRHIS ;COMPUTE IT + SKIPE GFRLST + PUSHJ P,GFRHP ;IF 'LIST' SPECIFIED, PRINT IT OUT + POPJ P, + +GFRHIS: .RDATE A, + SETOM MFDIN + SETOM GFRFLG + SETZM CURDAT + LDB B,[000600,,A] ;LOW DIGIT OF DAY + SUBI B,20 + LDB C,[060600,,A] ;HIGH DIGIT OF DAY + SUBI C,20 + IMULI C,10. + ADD C,B + DPB C,[220500,,CURDAT] ;STORE DAY IN DAY FIELD OF DISK-DATE WORD + LDB B,[140600,,A] ;SAME WITH MONTH + SUBI B,20 + LDB C,[220600,,A] + SUBI C,20 + IMULI C,10. + ADD C,B + DPB C,[270400,,CURDAT] + LDB B,[300600,,A] ;SAME WITH YEAR + SUBI B,20 + LDB C, [360600,,A] + SUBI C,20 + IMULI C,10. + ADD C,B + DPB C,[330700,,CURDAT] ;NOW HAVE CURRENT TIME IN DISK FORMAT + MOVE A,CURDAT ;[I DON'T KNOW WHAT'S WRONG WITH ******* + SUBI C,GFRYRS ; THE RQDATE SYSTEM CALL] ******* + DPB C,[330700,,A] + MOVEM A,OLDDAT ;OLDEST FILE DATE IS GFRYRS YEARS AGO ******* + SETZM GFRBLK + MOVE A,[GFRBLK,,GFRBLK+1] + BLT A,GFRBLK+LGFRBLK-1 +GFR1: PUSHJ P,MFDN ;READ A DIRECTORY + JRST GFRF + PUSHJ P,GFRUCK ;SEE IF THIS DIRECTORY SHOULD NOT BE REEPED + JRST GFR1 + .SUSET [.SSNAM,,USNM] + SETOM FLNI +GFR2: PUSHJ P,FNG ;READ A FILE + JRST GFR1 + SKIPE LNKFLG ;DO NOTHING FOR LINKS + JRST GFR2 + SKIPN A,RFDATE ;DON'T COUNT FILES WITHOUT REFERENCE DATES + JRST GFR2 + CAMG A,OLDDAT ;IF OLDER THAN GFRYRS, USE OLDDAT + MOVE A,OLDDAT + PUSHJ P,GFROFS ;COMPUTE OFFSET + MOVE B,FLENTH + ADDM B,GFRBLK(A) ;INCREMENT COUNT OF BLOCKS ON THAT DATE + JRST GFR2 ;NEXT FILE + +;HISTOGRAM ALL DONE +GFRF: SETZM GFRFLG + SETZM A + MOVEI B,GFRBLK +GFRTOT: ADD A,(B) + HRLM A,(B) ;RH INCREMENT, LH RUNNING SUM + AOS B + CAIG B,GFRBLK+LGFRBLK-1 + JRST GFRTOT + POPJ P, + +;GIVEN A DATE IN A, COMPUTE NUMBER OF DAYS SINCE DATE IN OLDDAT +GFROFS: SETZM B + LDB C,[330700,,OLDDAT] ;SUBTRACT YEARS + LDB D,[330700,,A] + SUB D,C + IMULI D,12.*31. ;APPARENTLY THERE ARE 372 DAYS PER YEAR + MOVE B,D ; AT LEAST IF EACH MONTH HAS 31 DAYS + LDB C,[270400,,OLDDAT] ;SUBTRACT MONTHS + LDB D,[270400,,A] + SUB D,C + IMULI D,31. + ADD B,D + LDB C,[220500,,OLDDAT] ;SUBTRACT DAYS + LDB D,[220500,,A] + SUB D,C + ADD B,D + MOVE A,B + CAILE A,LGFRBLK-2 ;DON'T GET FAKED OUT BY FILES + MOVEI A,LGFRBLK-2 ; BROUGHT BACK FROM THE FUTURE + POPJ P, + +;PRINT GFR HISTOGRAM +GFRHP: MOVEI B,GFRBLK +GFRHPT: HRRZ A,(B) + SKIPN A + JRST GFRHP1 + PUSHJ P,CRR + PUSHJ P,GFROFI ;OFFSET BACK TO DATE + PUSHJ P,GFRPDT ;PRINT DATE + PASC [ASCIZ / /] + HRRZ A,(B) + PDPT A ;PRINT INCREMENT IN BLOCKS + HLRZ A,(B) + PDPT A ;PRINT TOTAL BLOCKS +GFRHP1: AOS B + CAIG B,GFRBLK+LGFRBLK-1 + JRST GFRHPT + POPJ P, + +;PRINT DATE IN A +GFRPDT: PUSH P,B + PUSH P,A + LDB B,[270400,,A] ;MONTH + PSIS MONTH(B) + PUSHJ P,TYOS + LDB A,[220500,,A] ;DAY + CAIGE A,10. + PUSHJ P,TYOS + PUSHJ P,DPT + PASC [ASCIZ /, /] + POP P,A + LDB A,[330700,,A] ;YEAR + ADDI A,1900. + PUSHJ P,DPT + POP P,B + POPJ P, + +;CONVERT GFRBLK POINTER IN B BACK FROM OFFSET INTO DATE +;SOMEONE SHOULD DOCUMENT THIS PURE MAGIC +;OK, here is the explanation: +; The date of GFRBLK+0 is stored in OLDDAT. If we pretend that every +; month has 31. days, then GFRBLK+ would have the date C(OLDDAT)+. +; (Where is measured in days, and date arithmetic is done appropriately.) +; Thus, some locations in GFRBLK correspond to impossible dates such as +; February 30. For some reason, people never create files on those dates... +GFROFI: LDB C,[330700,,OLDDAT] ; C: old-year + LDB D,[270400,,OLDDAT] ; D: old-month + LDB E,[220500,,OLDDAT] ; E: old-day + PUSH P,B + SUBI B,GFRBLK + MOVE A,B + IDIVI A,12.*31. ; A: years, B: remainder + ADD C,A + MOVE A,B + IDIVI A,31. ; A: months (0 - 11.), B: days (0 - 31.) + ADD D,A + ADD E,B + CAILE E,31. + AOS D + CAILE E,31. + SUBI E,31. + CAILE D,12. + AOS C + CAILE D,12. + SUBI D,12. + CAILE D,12. + AOS C + CAILE D,12. + SUBI D,12. + POP P,B + SETZM A + DPB C,[330700,,A] + DPB D,[270400,,A] + DPB E,[220500,,A] + POPJ P, + +GFRFLG: 0 ;MAGIC ARGUMENT TO FNG +CURDAT: 0 ;CURRENT DISK-FORMAT DATE +OLDDAT: 0 ;BASE DISK-FORMAT DATE FOR GFRBLK +GFRYRS==:2 ; 2 year histogram +LGFRBLK==:+1 ;1 ENTRY FOR EACH DAY, 1 EXTRA AT END FOR TOTAL +GFRBLK: BLOCK LGFRBLK + +MONTH: 0 + SIXBIT /JAN/ + SIXBIT /FEB/ + SIXBIT /MAR/ + SIXBIT /APR/ + SIXBIT /MAY/ + SIXBIT /JUN/ + SIXBIT /JUL/ + SIXBIT /AUG/ + SIXBIT /SEP/ + SIXBIT /OCT/ + SIXBIT /NOV/ + SIXBIT /DEC/ + + +;GFRUCK - Skip if it's OK to reap this directory + +GFRUCK: + ; Very grim procedure. + SKIPE GFREVR ;Are we reaping all directories? + JRST POPJ1 ; Yes - reap 'em all. + + ; Discriminatory reap procedures. + SKIPN GFRJST ;If we are not being discriminatory + JRST GFRUC2 ; follow normal procedures. + MOVSI A,-NBADDY ;Number of discriminated against dirs. +GFRUC1: CAMN B,BADDY(A) ;Is this dir a baddy? + JRST POPJ1 ; Yes - it should be reaped. + AOBJN A,GFRUC1 + POPJ P, ;No, a normal dir. Don't reap it. + + ; Nondiscriminatory reap procedure. +GFRUC2: HLRZ A,USNM + CAIE A,(SIXBIT /SYS/) ;Never reap system dirs + CAIN A,(SIXBIT /LIB/) ;Never reap libraries. + POPJ P, + MOVE B,USNM ;Don't reap the DUMP database! + MOVSI A,-NTDIR +GFRUC3: CAMN B,TDIRTB(A) + POPJ P, + AOBJN A,GFRUC3 + SKIPE WRONG + DIE Cannot GFR because this version of DUMP is for the wrong machine + MOVSI A,-NSDIR ;Check list of specially protected dirs. +GFRUC4: CAMN B,SDIR(A) ;Is this dir in the list? + POPJ P, ; Yes, do not reap it. + AOBJN A,GFRUC4 + JRST POPJ1 ;Not in the list - reap it. + + + +SUBTTL SPECIALLY PROTECTED DIRS TO BE HAND REAPED ONLY + +SDIR: SIXBIT /./ + SIXBIT /.BULK./ + SIXBIT /.INFO./ + SIXBIT /.MAIL./ + SIXBIT /.TECO./ + SIXBIT /ACOUNT/ + SIXBIT /BACKUP/ + SIXBIT /C/ + SIXBIT /DEVICE/ + SIXBIT /EMACS/ + SIXBIT /EMACS1/ + SIXBIT /FONTS/ + SIXBIT /FONTS1/ + SIXBIT /INFO/ + SIXBIT /INQUIR/ + SIXBIT /LISP/ + SIXBIT /MAINT/ + +IFE MCOND AI,[ + SIXBIT /COMLAP/ + SIXBIT /DECSYS/ + SIXBIT /KLDCP/ + SIXBIT /KSC/ + SIXBIT /KSHACK/ + SIXBIT /L/ + SIXBIT /LSPMAI/ + SIXBIT /MIDAS/ + SIXBIT /SAIL/ + SIXBIT /UCODE/ +;Macsyma-related directories: +;(should be moved to the ML list when it comes up) +;Well, its up now, but perhaps we have decided to leave Macsyma on AI? + SIXBIT /ALJABR/ + SIXBIT /DEMO/ + SIXBIT /LMMAXQ/ + SIXBIT /MACDOC/ + SIXBIT /MACSYM/ + SIXBIT /MAXDOC/ + SIXBIT /MAXDMP/ + SIXBIT /MAXERR/ + SIXBIT /MAXER1/ + SIXBIT /MAXTUL/ + SIXBIT /MAXOUT/ + SIXBIT /MUNFAS/ + SIXBIT /SHARE/ + SIXBIT /SHARE1/ + SIXBIT /SHARE2/ + SIXBIT /SHAREM/ +] + +IFE MCOND MC,[ ; (The KS) + SIXBIT /ANBB/ + SIXBIT /DUPSYS/ + SIXBIT /KSC/ + SIXBIT /LSPMAI/ +] + +IFE MCOND MX,[ ; (The KL) + SIXBIT /.DOVR./ + SIXBIT /.KLFE./ + SIXBIT /KLDCP/ + SIXBIT /KSC/ + SIXBIT /L/ + SIXBIT /MIDAS/ + SIXBIT /UCODE/ +;Macsyma-related directories: + SIXBIT /ALJABR/ + SIXBIT /DEMO/ + SIXBIT /LMMAXQ/ + SIXBIT /MACDOC/ + SIXBIT /MACSYM/ + SIXBIT /MAXDOC/ + SIXBIT /MAXDMP/ + SIXBIT /MAXERR/ + SIXBIT /MAXER1/ + SIXBIT /MAXTUL/ + SIXBIT /MAXOUT/ + SIXBIT /MUNFAS/ + SIXBIT /SHARE/ + SIXBIT /SHARE1/ + SIXBIT /SHARE2/ + SIXBIT /SHAREM/ +] + +IFE MCOND DM,[ + SIXBIT /%SYS/ + SIXBIT /.BATCH/ + SIXBIT /COMDAT/ + SIXBIT /COMMUD/ + SIXBIT /COMPIL/ + SIXBIT /COMSAV/ + SIXBIT /CPROG/ + SIXBIT /FONTS2/ + SIXBIT /MADMAN/ + SIXBIT /MBPROG/ + SIXBIT /MPROG/ + SIXBIT /MPROG1/ + SIXBIT /MPROG2/ + SIXBIT /MUDBUG/ + SIXBIT /MUDDLE/ + SIXBIT /MUDMAN/ + SIXBIT /MUDSAV/ + SIXBIT /MUDSYS/ + SIXBIT /NCOMPI/ + SIXBIT /NETDOC/ + SIXBIT /R/ + SIXBIT /READER/ + SIXBIT /XFONT/ +] + +IFE MCOND AIKA,[ + SIXBIT /CNVR/ + SIXBIT /COMLAP/ + SIXBIT /L/ + SIXBIT /LMCONS/ + SIXBIT /LMDOC/ + SIXBIT /MIDAS/ + SIXBIT /PUB/ + SIXBIT /SAIL/ + SIXBIT /VIS/ + SIXBIT /WP/ +] + +NSDIR==.-SDIR + + + +SUBTTL DIRS TO BE DISCRIMINATORILY REAPED + +BADDY: + SIXBIT /FOOBAR/ +NBADDY==.-BADDY + + + SUBTTL FILE NAME READER + +;THE FOLLOWING ROUTINE GOBBLES INPUT LINES +;FROM THE TTY AND INTERPRETS THEM AS STANDARD MIDAS OR COPY INPUT +;LINES. EX. TODEV:TOSNM;TOFN1 TOFN2_FMDEV:FMSNM;FMFN1 FMFN2(CR) +;THE ROUTINE KEEPS TYPING FILE= AND WAITS FOR ANOTHER LINE +;UNTIL AN ALTMODE A LONELY CR IS TYPED. ALL THE TODEV'S ARE STORED IN A LIST +;CALLED TODEV:. ALL THE FMFN1'S ARE STORED ON A LIST CALLED FMFN1: +;ETC. THERE ARE EIGHT LISTS IN ALL. AN UNSPECIFIED ARGUMENT IN THE +;LINE IS GIVEN THE VALUE OF THE DEFAULT FOR +;THAT SPEC. A SPECIFIED ARG BECOMES THE DEFAULT FOR THAT SPEC. +;IF THE _ IS OMMITTED, ALL ARGS ARE FM ARGS. +;INITIAL DEFAULT FOR FM NAMES IS DSK:;* * +;THE ROUTINE EXITS IF THE LAST INPUT LINE OF FM NAMES +;EVALUATES TO *;* * +;TO NAMES UNSPECIFIED IN A LINE ARE SET +;TO FM NAMES OF THE SAME CORRESPONDING TYPE(DEV,SNM,FN1,FN2) + +FILGET: MOVSI D,-LLIST ;NUMBER OF ENTRIES ALLOWED + SETZM FMDUMP(D) + AOBJN D,.-1 + MOVSI D,-LLIST + CAIA +ONEFIL: MOVSI D,-1 ;ENTRY FOR ONLY ONE SPEC TO BE READ + MOVSI X,(SIXBIT /DSK/) ;DEFAULT FOR DEV + MOVE U,MYNAME ;DEFAULT FOR SNAME + MOVE V,[SIXBIT /*/] ;FIRST FILE NAME DEFAULT + MOVE W,V ;SECOND FILE NAME DEFAULT + IRP X,,[TO,FM] + IRP Y,,[DEV,SNM,FN1,FN2] + SETZM !X!!Y + MOVE A,[!X!!Y,,!X!!Y+1] + BLT A,!X!!Y+LLIST-1 + TERMIN + TERMIN +TRAGEN: PRINT FILE= + SETZM TINDEV + MOVE A,[TINDEV,,TINSNM] + BLT A,TINFN2 ;SO UNSPECIFIEDS WILL BE 0 + SETOM BARROW ;SAYS NO BACK-ARROW TYPED YET + PUSHJ P,TYI + CAIE A,33 + CAIN A,15 + JRST TIDONE ;LONELY CR + PUSHJ P,GETSL1 ;READ A SYLLABLE BUT FIRST CHARACTER ALREADY READ + JRST TRAGEN ;ENTIRE SYLLABLE RUBBED OUT + JRST OVER + +TGET: PUSHJ P,GETSYL + JRST TRAGEN +OVER: CAIN TER,": + JRST TDEV + CAIN TER,"; + JRST TSNM + CAIN TER,40 + JUMPE SYM,TGET + CAIN TER,^F + JUMPE SYM,TRRDF ;INDIRECT AND READ FILE TO GET FILE NAMES + CAIE TER,33 + CAIN TER,15 + JUMPE SYM,ENDLIN + CAIN TER,"_ + JUMPE SYM,BASET + SKIPN TINFN1 + JRST TFN1 + SKIPE TINFN2 + MOVEI TER,40 ;MORE THAN TWO FILE NAMES + SKIPE TINFN2 + JRST TOMANY + MOVEM SYM,TINFN2 + JRST TFNC + +TFN1: MOVEM SYM,TINFN1 + JRST TFNC + +TFNC: CAIN TER,40 + JRST TGET + CAIN TER,"_ + JRST BASET + CAIN TER,^F + JRST TRRDF ;INDIRECT TO READ FILE +ENDLIN: AOS BARROW ;NO BACKARROW IMPLIES ONLY FM NAMES + AOS BARROW + PUSHJ P,DACIT +IRP X,,[DEV,SNM,FN1,FN2] + SKIPN A,TO!X(D) + JRST Z!X + CAME A,[SIXBIT /*/] + JRST NZ!X +Z!X: MOVE A,FM!X(D) + MOVEM A,TO!X(D) +NZ!X: +TERMIN + AOBJN D,.+1 + MOVEI A,0 + CAMN A,TYNSNM + CAME A,TYNFN1 + JRST NOCOM + CAMN A,TYNFN2 + JRST TIDONE ;CAN'T ASK FOR MORE THAN THE UNIVERSE ! +NOCOM: CAIN TER,33 + JRST TIDONE ;ALTMODE MEANS NO MORE LINES TO BE TYPED + JUMPL D,TRAGEN + JRST NOMORE ;FILE SPEC BUFFER FULL + +TRRDF: MOVSI A,'DSK + SKIPN TINDEV + MOVEM A,TINDEV + MOVE A,MYNAME + SKIPN TINSNM + MOVEM A,TINSNM + AOS TYIPD ;DEPTH IN IOPUSHES ON TYIC + .IOPUSH TYIC, + .CALL TRRDFO + JRST TRRDFL + JRST TRAGEN ;CONTINUE PROCESSING FILE SPECS (FROM DISK NOW) + +TRRDFL: PRINT [INDIRECT FILE ERROR; ] + PUSHJ P,OPINFL + SOS TYIPD + .IOPOP TYIC, + JRST TRAGEN + +BASET: PUSHJ P,DACIT + AOSE BARROW + JRST TOMANY + SETZM TINDEV + MOVE A,[TINDEV,,TINSNM] + SETZM TINDEV + BLT A,TINFN2 + JRST TGET + +NOMORE: CAIN D,1 + JRST TIDONE ;DON'T SAY FILE IF ONLY ONE LINE WAS ASKED FOR + PRINT FILE= + PUSHJ P,TYI ;PRETEND TO WANT ONE MORE, BUT BARF IF ONE GIVEN + CAIE A,15 + JRST TOOMCH +TIDONE: HRRZM D,LENGTH + SKIPN LENGTH + JRST MLP ;NO ENTRIES + JRST CRR + +;APPLY DEFAULTS TO THE TYPED-IN FILE NAME +DEFINE INITFD AC,DES + SKIPN E,TYN!DES + MOVEM AC,TYN!DES ;SET UNSPECIFIED ARG TO DEFAULT + CAIE E,0 + MOVE AC,E ;SET DEFAULT TO SPECIFIED ARG + CAMN AC,[SIXBIT /*/] + SETZM TYN!DES ;ASTERISKS MATCH TO ANYTHING + CAME AC,[SIXBIT / */] + JRST NOAST!AC + MOVE E,[SIXBIT /*/] + MOVEM E,TYN!DES ;SPACE * GETS CHANGED TO A REAL ASTERISK +NOAST!AC: +TERMIN + +DACIT: MOVSI B,-4 + MOVE A,[TINDEV,,TYNDEV] + BLT A,TYNFN2 + SKIPG BARROW + JRST ENDLUP + IRP K,,[X,U,V,W]B,,[DEV,SNM,FN1,FN2] + INITFD K,B + TERMIN + MOVSI C,(SIXBIT /DSK/) + SKIPE A,TYNDEV + CAMN A,[SIXBIT /*/] + MOVEM C,TYNDEV +ENDLUP: MOVE A,TYNDEV(B) + SKIPL BARROW + PUSHJ P,FMLST + SKIPGE BARROW + PUSHJ P,TOLST + AOBJN B,ENDLUP + POPJ P, + +TOOMCH: PRINT _NO MORE ENTRIES ALLOWED. +QUES: PRINT SHALL I CONTINUE? + .RESET TYIC, + PUSHJ P,TYI + CAIN A,"Y + JRST TIDONE + CAIN A,"N + JRST MLP + PRINT _TYPE Y FOR YES OR N FOR QUIT._ + JRST QUES + +;I HAVE NO IDEA WHETHER THESE DO ANYTHING ******* +IRP X,,[TO,FM] +X!LST: MOVEI C,LLIST + IMULI C,(B) + ADDI C,X!DEV(D) + MOVEM A,(C) + POPJ P, +TERMIN + +IRP X,,[DEV,SNM] +T!X: SKIPE TIN!X + JRST TOMANY + MOVEM SYM,TIN!X + JRST TGET +TERMIN + +TOMANY: PRINT UNACCEPTABLE WITH + CAIN TER,"_ + JRST NOTWO + CAIE TER,": + CAIN TER,"; + JRST NOTWO + PUSHJ P,TYOS + PRINT THREE FILE NAMES! + MOVEI TER,0 + CAIA +NOTWO: PUSHJ P,TYOS + CAIE TER,": + CAIN TER,"; + PRINT TWO + CAIN TER,"_ + PRINT TWO + CAIE TER,0 + PUSHJ P,TYOS + CAIN TER,"; + PRINT SNAMES! + CAIN TER,": + PRINT DEVICES! + CAIN TER,"_ + PRINT BACKARROWS! + PUSHJ P,CRR + JRST TRAGEN + SUBTTL MAGIC ROUTINES TO CALL FROM DDT + +;WHO KNOWS WHAT THIS DOES? +TRAN: SETOM MFDIN +TRAN1: PUSHJ P,MFDN + .VALUE + SETOM FLNI + .SUSET [.SSNAM,,USNM] +TRAN2: PUSHJ P,FNG + JRST TRAN1 + .OPEN DSKIN,TRNI + JRST TRAN2 + SKIPE LNKFLG + JRST TRAN2 + .CALL RDATE + JFCL + SKIPG FDATE + JRST TRAN2 + MOVE A,FDATE + TLO A,110000 + CAML A,TOMDAT + SUB A,[2000,,0] + MOVEM A,FDATE + .CALL SFDAT1 + JFCL + JRST TRAN2 + +TOMDAT: 0 + +SFDAT1: SETZ + SIXBIT /SFDATE/ + [DSKIN] + SETZ FDATE + +;CONVERT FROM OLD .TAPEn; TAPE nnn FILE FORMAT TO NEW (1975?) +CONV: MOVE A,TDIRTB + MOVEM A,USNM + SETOM FLNI + .SUSET [.SSNAME,,USNM] +CONV1: PUSHJ P,FNG + .VALUE + MOVEI A,.BII + HRLM A,TRNI + OPEN DSKIN,TRNI + .VALUE + MOVEI B,.BIO + HRLM B,TRNI + OPEN DSKOUT,TRNI + .VALUE + HRLM A,TRNI + .CALL RDATE + SETOM FDATE + .CALL SDATE + JFCL + .CALL SRDT1 + JFCL + SETOM USNM + MOVE A,[-5,,BUF] + .IOT DSKIN,A + MOVE A,[-3,,0] + MOVEM A,BUF+4 + MOVE A,[-5,,BUF] + .IOT DSKOUT,A +CONV2: MOVE A,[-5,,BUF] + .IOT DSKIN,A + JUMPL A,CONV3 + MOVE A,BUF + CAME A,USNM + PUSHJ P,CONV4 + MOVE A,[-2,,BUF+1] + .IOT DSKOUT,A + HRROI A,BUF+4 + .IOT DSKOUT,A + JRST CONV2 + +CONV3: .CLOSE DSKOUT, + .CLOSE DSKIN, + JRST CONV1 + +CONV4: MOVEM A,USNM + HRROI A,[0] + .IOT DSKOUT,A + HRROI A,USNM + .IOT DSKOUT,A + POPJ P, + +SRDT1: SETZ + SIXBIT /SRDATE/ + [DSKOUT] + SETZ RFDATE + +;ORDMFD$G WILL RUN THRU ALL THE .TAPE. FILES, AND PRODUCE A LIST +; OF DIRECTORIES WHICH HAVE EVER BEEN DUMPED +; (THIS IS A FILE OF SIXBIT, UNORDERED) + +ORDM1: -40000,,SBUF ;POINT TO A BUFFER +ORDM2: -40000,,SBUF ;POINT TO CURRENT END +ORDIR: 0 ;NAME OF A TAPE DIR +ORDIRS: 0 ;NAME OF SAVED DIR +DIRFLG: 0 ;FLAG SAYS THAT NEXT IS A DIR + +ORDMFD: .CORE CORSZB + JRST .-1 + MOVE A,[-40000,,SBUF] + MOVEM A,ORDM1 + MOVEM A,ORDM2 + .SUSET [.RSNAM,,ORDIRS] + SETOM TDIRN +OM0: AOS A,TDIRN + CAIGE A,NTDIR + JRST [ MOVE A,TDIRTB(A) + MOVEM A,ORDIR + PUSHJ P,OM1 + JRST OM0 ] + .SUSET [.SSNAM,,ORDIRS] ;RESET SNAM + OPEN DSKOUT,[SIXBIT / &DSKDMPMFD>/] + .VALUE + MOVE A,ORDM1 + SUB A,ORDM2 ;# WDS IN BUF + MOVSS A + HRRI A,ORDM1 + .IOT DSKOUT,A + .CLOSE DSKOUT, + .VALUE [ASCIZ /TAPES.SCANNED.FOR.MFD/] + +OM1: SETOM FLNI ;ROUTINE TO SCAN A .TAPE DIR + .SUSET [.SSNAM,,A] +OM1A: PUSHJ P,FNG + POPJ P, ;END OF DIR + PUSHJ P,OM2 + JRST OM1A + +OM2: SETOM EOFF ;ROUTINE TO SCAN A .TAPE FILE + OPEN DSKIN,TRNI + .VALUE + MOVEI B,0 + JSR GWD + CAME A,[-4,,] ;GOOD HEADER + .VALUE + JSR GWD ;TAPE# + JSR GWD ;DATE + JSR GWD ;FLAGS + JFCL ;JUMPGE A,CPOPJ IF ONLY INCR WANTED + JSR GWD ;ANOTHER RANDOM + CAME A,[-3,,] ;MORE GOOD HEADER + .VALUE + JSR GWD ;SHOULD BE FOR A DIR NAME HERE + CAME A,DIRFLG + .VALUE +OM2B: JSR GWD ;GET DIR NAME + PUSHJ P,OMFD ;INSERT NAME IN LIST +OM2C: JSR GWD ;GET FN1 OR FLAG + CAMN A,DIRFLG + JRST OM2B ;A DIR + JSR GWD ;WAS FN1, GET FN2 + JSR GWD ;DATE + JRST OM2C + +OMFD: MOVE C,ORDM2 ;PUT A WORD IN LIST (IF UNIQUE) + MOVEM A,(C) + MOVE C,ORDM1 ;SEARCH + CAME A,(C) + AOBJN C,.-1 + CAME C,ORDM2 ;SKIP IF REACHED END OF LIST + POPJ P, ;NOT A NEW NAME + AOBJP C,[.VALUE] ;REACHED END??? + MOVEM C,ORDM2 ;BUMP POINTER NOW + POPJ P, + +;WHO KNOWS WHAT THIS DOES? +ORFIND: .CORE CORSZB + JRST .-1 + SETOM MFDIN +OF1: PUSHJ P,MFDN + .VALUE + MOVEM A,SCRDIR+2 + .SUSET [.SSNAM,, [SIXBIT /TAPSCR/]] + OPEN DSKOUT,SCRDIR + .VALUE + SETOM TDIRN +OF1A: AOS A,TDIRN + CAIL A,NTDIR + JRST OF1 ;LOOP FOR ANOTHER NAME + MOVE A,TDIRTB(A) + MOVEM A,ORDIR + PUSHJ P,OF2 + JRST OF1A + +SCRDIR: 7,,446353 + SIXBIT /TAPE/ + 0 + +OF2: SETOM FLNI + .SUSET [.SSNAM,,A] +OF3: PUSHJ P,FNG + POPJ P, + SETOM EOFF + OPEN DSKIN,TRNI + .VALUE + MOVE A,[-5,,BUF] + .IOT DSKIN,A + SKIPL BUF+3 + JRST OF3 ;NOT INCREMENTAL + PUSHJ P,OF4 + JRST OF3 + +OF4: MOVEI B,0 + MOVE A,TRNI+2 + MOVEM A,DATA+3 + JSR GWD +OF7: PUSHJ P,OF5 + POPJ P, + JSR GWD +OF6: MOVEM A,DATA + JSR GWD + MOVEM A,DATA+1 + JSR GWD + MOVEM A,DATA+2 + MOVE A,[-4,,DATA] + .IOT DSKOUT,A + JSR GWD + SKIPN A + JRST OF7 + JRST OF6 + +DATA: BLOCK 4 + +OF5: JSR GWD + CAMN A,USNM + JRST POPJ1 + JRST OF8 + +OF9: JSR GWD + JSR GWD +OF8: JSR GWD + SKIPN A + JRST OF5 + JRST OF9 + +;WHO KNOWS WHAT THIS DOES? +OFSORT: .CORE CORSZB + JRST .-1 + SETOM FLNI + .SUSET [.SSNAM,,[SIXBIT /TAPSCR/]] +OFS1: PUSHJ P,FNG + .VALUE + MOVE A,[-40000,,SBUF] + MOVEI B,.BII + HRLM B,TRNI + OPEN DSKIN,TRNI + .VALUE + .IOT DSKIN,A + SKIPL A + .VALUE + MOVEM A,SORTAS + HRRZ C,A + HRRZI A,SBUF + MOVEI D,4 + MOVEI N,0 + SETZM (C) + PUSHJ P,SORT + MOVEI A,SBUF + MOVEI N,1 + MOVE C,A +OFS2: SKIPN B,(A) + JRST OFS4 +OFS3: ADDI C,4 + CAMN B,(C) + JRST OFS3 + PUSHJ P,SORT + JRST OFS2 + +OFS4: MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE + HRLM A,TRNI + .CLOSE DSKIN, + OPEN DSKOUT,TRNI + .VALUE + .ACCESS DSKOUT,[0] + MOVE A,[-40000,,SBUF] + HLLZ B,SORTAS + SUB A,B + .IOT DSKOUT,A + .CLOSE DSKOUT, + JRST OFS1 + +OUTNAM: .CORE CORSZB + JRST .-1 + MOVE B,[440600,,A] + MOVSI C,-6 +OUTNM1: ILDB D,B + ADDI D,40 + PUSHJ P,OUTASC + AOBJN C,OUTNM1 + POPJ P, + +OUTNUM: MOVE B,[440600,,A] + MOVSI C,-3 +OUTNU1: ILDB D,B + ADDI D,40 + PUSHJ P,OUTASC + AOBJN C,OUTNM1 + POPJ P, + +OUTDAT: MOVE B,[270400,,A] + MOVEI D,"0 + LDB C,B + CAIL C,10. + MOVEI D,"1 + PUSHJ P,OUTASC + CAIL C,10. + SUBI C,10. + ADDI C,"0 + MOVE D,C + PUSHJ P,OUTASC + MOVEI D,"/ + PUSHJ P,OUTASC + MOVE B,[220500,,A] + LDB B,B + IDIVI B,10. + ADDI B,"0 + MOVE D,B + PUSHJ P,OUTASC + ADDI C,"0 + MOVE D,C + PUSHJ P,OUTASC + MOVEI D,"/ + PUSHJ P,OUTASC + MOVE B,[330700,,A] + LDB B,B + CAIGE B,72. + ADDI B,72. + IDIVI B,10. + ADDI B,"0 + MOVE D,B + PUSHJ P,OUTASC + ADDI C,"0 + MOVE D,C + PUSHJ P,OUTASC + POPJ P, + +OUTCR: MOVEI D,15 + PUSHJ P,OUTASC + MOVEI D,12 + JRST OUTASC + +OUTSPC: MOVEI D," + JRST OUTASC + +OUT4SP: MOVEI D," + MOVSI B,-4 + PUSHJ P,OUTASC + AOBJN B,.-1 + POPJ P, + +OUTASC: MOVE U,ASCBP + CAMN U,[010700,,BUF+2000-1] + PUSHJ P,OUTBLK + IDPB D,ASCBP + POPJ P, + +OUTBLK: MOVE U,[-2000,,BUF] + .IOT DSKOUT,U + MOVE U,[440700,,BUF] + MOVEM U,ASCBP + POPJ P, + +ASCBP: 440700,,BUF + +CONASC: .CORE CORSZB + JRST .-1 + SETOM FLNI +CONAS1: .SUSET [.SSNAM,,[SIXBIT /TAPSCR/]] + PUSHJ P,FNG + .VALUE + MOVEI A,.BII + HRLM A,TRNI + OPEN DSKIN,TRNI + .VALUE + .SUSET [.SSNAM,,[SIXBIT /TAPASC/]] + MOVEI A,.BIO + HRLM A,TRNI + OPEN DSKOUT,TRNI + .VALUE + MOVE A,[440700,,BUF] + MOVEM A,ASCBP + MOVE A,[-40000,,SBUF] + .IOT DSKIN,A + MOVEM A,SORTAS + HRRZS A + SUBI A,SBUF + IDIVI A,4 + MOVEM A,NUMENT + MOVEI X,SBUF +CONAS2: MOVE A,NUMENT + ADDI A,3 + IDIVI A,4 + SETZM FUDGE+2 + SETZM FUDGE+3 + CAILE A,57 + JRST CONAS6 + MOVEI C,4 + CAIN B,0 + MOVEM C,FUDGE+2 + CAIN B,1 + MOVEM C,FUDGE+3 + MOVEI C,8 + CAIN B,0 + MOVEM C,FUDGE+3 +CONAS6: CAIL A,57. + MOVEI A,57. + MOVEM A,LINPAG +CONAS3: MOVNI V,(A) + HRLZS V +CONAS4: MOVSI W,-4 +CONAS5: MOVE E,LINPAG + IMULI E,4 + IMULI E,(W) + ADD E,X + SUB E,FUDGE(W) + MOVE A,(E) + PUSHJ P,OUTNAM + PUSHJ P,OUTSPC + MOVE A,(E)1 + PUSHJ P,OUTNAM + PUSHJ P,OUTSPC + MOVE A,(E)2 + PUSHJ P,OUTDAT + PUSHJ P,OUTSPC + MOVE A,(E)3 + PUSHJ P,OUTNUM + CAME W,[-1,,3] + PUSHJ P,OUT4SP + CAMN W,[-1,,3] + PUSHJ P,OUTCR + SOSN NUMENT + JRST ASCEOF + AOBJN W,CONAS5 + ADDI X,4 + AOBJN V,CONAS4 + MOVEI D,^L + PUSHJ P,OUTASC + MOVE D,LINPAG + IMULI D,12. + ADD X,D + JRST CONAS2 + +FUDGE: 0 + 0 + 0 + 0 + +ASCEOF: MOVEI D,3 +ASCEF1: PUSHJ P,OUTASC + HLRZ A,ASCBP + CAIE A,10700 + JRST ASCEF1 + HRRZ A,ASCBP + ADDI A,1 + SUBI A,BUF + MOVNS A + HRLZS A + HRRI A,BUF + .IOT DSKOUT,A + .CLOSE DSKOUT, + JRST CONAS1 + +NUMENT: 0 +LINPAG: 0 + +LNKBL: 200000,,446353 + BLOCK 4 + SIXBIT /TAPASC/ +LNKSNM: SIXBIT /.LPTR./ + +OFMLNK: SETOM FLNI + .SUSET [.SSNAM,,[SIXBIT /TAPASC/]] +ML1: PUSHJ P,FNG + .VALUE + .SUSET [.SSNAM,,LNKSNM] + MOVE A,FN1 + MOVEM A,LNKBL+1 + MOVEM A,LNKBL+3 + MOVE A,FN2 + MOVEM A,LNKBL+2 + MOVEM A,LNKBL+4 + .OPEN DSKIN,LNKBL + .VALUE + JRST ML1 + +;CHECK FOR CLOBBERED FILES (CONTAIN 'CLBWRD') +CHECCL: .CORE CORSZB + JRST .-1 + SETOM MFDIN + PUSHJ P,DEVGET +CHECL1: PUSHJ P,MFDN + JRST RET + SETOM FLNI + .SUSET [.SSNAM,,USNM] +CHSNM: PUSHJ P,FNG + JRST CHECL1 + SKIPE LNKFLG + JRST CHSNM + HRRI A,.BII + HRLM A,TRNI + OPEN DSKIN,TRNI + JRST CHSNM +CHSNM1: MOVE A,[-40000,,SORTAS] + .IOT DSKIN,A + PUSH P,A + HLLZS A + MOVE B,[-40000,,0] + SUB B,A + HRRI B,SORTAS + MOVE C,CLBWRD +CHSNM4: MOVE D,(B) + TLZ D,770000 + CAME C,D + JRST CHSNM2 +CHSNM3: POP P,A + JUMPL B,CLBFL + JUMPGE A,CHSNM1 + .CLOSE DSKIN, + JRST CHSNM + +CHSNM2: ADD B,[1777,,1777] + AOBJN B,CHSNM4 + JRST CHSNM3 + +CLBFL: PSIS USNM + PSIS FN1 + PSIS FN2 + PDPT PACKN + .CALL RDATE + JFCL + MOVE A,FDATE + MOVEM A,DAYTIM + PASC [ASCIZ / /] + PUSHJ P,PFDATE + .CLOSE DSKIN, + PUSHJ P,CRR + JRST CHSNM + +CLBWRD: 600,,3 ;USUAL WORD FILES GET CLOBBERED WITH + +;MORE CHECKING FOR CLOBBERED FILES + +DIRSO: SIXBIT / &DSKWALL BIN / + +FBLK: .CORE CORSZB + JRST .-1 + .SUSET [.SSNAM,, [SIXBIT /SEC/]] + .OPEN 15,DIRSO + .VALUE + PUSHJ P,DEVGET +FBLK1: PUSHJ P,SFNG + .VALUE +FBLK5: .OPEN UFDCH,FNO + .VALUE + MOVE A,[-2000,,FDIRBF] + .IOT UFDCH,A + MOVEI A,.BII + HRLM A,TRNI + OPEN DSKIN,TRNI + JRST FBLK1 + MOVNI A,3 + MOVEM A,BLKOFS +FBLK2: MOVE A,[-6000,,SORTAS] + .IOT DSKIN,A + AOS BLKOFS + AOS BLKOFS + AOS BLKOFS + PUSH P,A + HLLZS A + MOVE B,[-6000,,0] + SUB B,A + HRRI B,SORTAS + MOVE C,CLBWRD +FBLK3: CAMN C,(B) + JRST FBLK4 + ADD B,[1777,,1777] + AOBJN B,FBLK3 + POP P,A + JUMPGE A,FBLK2 + .CLOSE DSKIN, + JRST FBLK1 + + +SFNG: MOVE A,[-1,,USNM] + .IOT 15,A + JUMPL A,CPOPJ + SKIPN USNM + POPJ P, + .SUSET [.SSNAM,,USNM] + MOVE A,[-2,,FN1] + .IOT 15,A + JRST POPJ1 + +FBLK4: POP P,A + PUSHJ P,CRR + PSIS USNM + PSIS FN1 + PSIS FN2 + HRRZS B + SUBI B,SORTAS + IDIVI B,2000 + ADD B,BLKOFS + PUSHJ P,DELBLK + PUSHJ P,FTRK + PDPT A + JRST FBLK5 + +DELBLK: PUSH P,B + IMULI B,2000 + MOVEI C,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT + HRLM C,TRNI + .OPEN DSKIN,TRNI + .VALUE + .ACCESS DSKIN,B + SETZM BUF ;CLOBBER WITH ZERO + MOVE C,[BUF,,BUF+1] + BLT C,BUF+1777 + MOVE C,[-2000,,BUF] + .IOT DSKIN,C + .CLOSE DSKIN, + POP P,B + MOVEI C,.BII + HRLM C,TRNI + POPJ P, + +FTRK: MOVE A,FDIRBF+1 + MOVEI A,FDIRBF(A) +FTRK1: MOVE C,(A) + CAME C,FN1 + JRST FTRK3 + MOVE C,1(A) + CAME C,FN2 + JRST FTRK3 + LDB C,[150500,,2(A)] + PDPT C + LDB C,[UNDSCP +2(A)] + IDIVI C,6 + MOVE D,BTB(D) + ADDI D,FDIRBF+11.(C) + SETOM A +FTRK2: ILDB C,D + TRZE C,40 + JRST FTRKL + CAILE C,12. + JRST FTRKS +FTRKN: AOS A + SOSGE B + POPJ P, + SOSLE C + JRST FTRKN + JRST FTRK2 + +FTRKS: SUBI C,11. + ADD A,C + SOSGE B + POPJ P, + JRST FTRK2 + +FTRKL: TRZ C,20 + SETZM A + DPB C,[140600,,A] + ILDB C,D + DPB C,[60600,,A] + ILDB C,D + DPB C,[600,,A] + SOSGE B + POPJ P, + JRST FTRK2 + +BLKOFS: 0 +BTB: 440600,, + 360600,, + 300600,, + 220600,, + 140600,, + 060600,, + +FTRK3: ADDI A,5 + CAIGE A,FDIRBF+1777 + JRST FTRK1 + SETOM A + POPJ P, + +;FIND PROBLEMS WITH CONVERTING TO NEW (1975?) .TAPEn; TAPE nnn FILE FORMAT +FNDCON: .CORE CORSZB + JRST .-1 + MOVSI V,-NTDIR +FNDCO1: MOVE B,TDIRTB(V) + SETOM FLNI + .SUSET [.SSNAM,,B] +FNDCO2: PUSHJ P,FNG + JRST FNDCO3 + MOVEI B,.BII + HRLM B,TRNI + OPEN DSKIN,TRNI + JRST FNDCO2 + .CALL FILLEN + .VALUE + SKIPN A,LENGTH + JRST FNDCO2 + .CALL FILBLK + .VALUE + MOVNS A + HRLS A + HRRI A,SBUF + .IOT DSKIN,A + MOVSI B,-10. +FNDCOX: SETZM (A) + AOS A + AOBJN B,FNDCOX + MOVE A,SBUF + CAME A,[-4,,0] + JRST FNDCO2 ;NOT A GOOD TAPE + MOVEI C,5 ;C WILL BE A POINTER INTO TAPE +FCLOOP: CAML C,LENGTH + JRST FNDCO4 + MOVE A,SBUF(C) + CAME A,[-1] + JRST FCL1 ;REGULAR FILE + MOVE A,SBUF+4(C) ;DATE OF NEXT FILE IF SNAME CHANGE + CAMN A,[-1] + JRST FCL3 + LSH A,-27. + CAIG A,2 ;OLD DATE + JRST FCL3 + CAIL A,71. + CAILE A,76. + JRST FCL2 +FCL3: SETZM SBUF(C) + ADDI C,2 + JRST FCLOOP + +FCL1: ADDI C,3 + JRST FCLOOP + +FCL2: MOVE A,SBUF+1(C) + PSIS A + JRST FCL1 + +FNDCO3: AOBJN V,FNDCO1 + JRST RET + +FNDCO4: .CLOSE DSKIN, + MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE + HRLM A,TRNI + OPEN DSKOUT,TRNI + .VALUE + .CALL SDATE + .VALUE + .CALL SRDT + .VALUE + MOVN A,LENGTH + HRLS A + HRRI A,SBUF + .IOT DSKOUT,A + .CLOSE DSKOUT, + JRST FNDCO2 + +;CONVERT OLD SYSENG;MACRO TAPES FORMAT TO NEW + +TFCONV: .SUSET [.SSNAME,,SPLACE] + MOVEI A,.BII + HRLM A,STATOP + OPEN DSKIN,STATOP + JRST RET + MOVEI A,.BIO + HRLM A,STATOP + OPEN DSKOUT,STATOP + JRST RET + SKIPE WRONG + DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine + MOVEI B,MAXTAP +TFCNV1: MOVE A,[-10.,,BUF] ; Currently TPINFL=10. (1/17/86) + .IOT DSKIN,A + JUMPL A,TFCNV2 + MOVE A,[-TPINFL,,BUF] + .IOT DSKOUT,A + SOJG B,TFCNV1 +TFCNV2: SETZM BUF +TFCNV3: MOVE A,[-TPINFL,,BUF] + .IOT DSKOUT,A + SOJG B,TFCNV3 + .CLOSE DSKIN, + .CLOSE DSKOUT, + .BREAK 16, + SUBTTL 'FIND', 'OFIND', and 'DFIND' COMMANDS + +;CODE TO FIND FILES BASED ON DSK:.TAPEX; DIRECTORIES REWRITTEN 12/8/77 BY PDL +; TO READ ALL DIRECTORIES AND SORT TAPE FILES BY CREATION DATE BEFORE +; SEARCHING. MOST RECENTLY DUMPED FILES ARE THEREFORE SEEN FIRST. + +; DEDDEV, DDIRTB, NDDIR + +DFIND: PRINT [ _FILES FOR ] + SIXTYP DEDITS + PRINT [ WHICH ARE STORED ON ] + SIXTYP DEDDEV + PRINT _ + SETZM OFINDF ;SAY WE ARE CHECKING FROM DISK. + SETOM DFINDF ;SAY THIS IS FOR A DECEASED ITS. + JRST AFIND1 + +OFIND: SETOM OFINDF ;DO A FIND FROM A TAPE INSTEAD OF .TAPEn + SKIPA ;THE TAPE CONTAINS .TAPEn; TAPE nnn FILES, + ; NOT USER FILES! +AFIND: SETZM OFINDF ;DOING A REGULAR FIND + SETZM DFINDF ;FROM A LIVE ITS +AFIND1: MOVSI A,-NFIGS + CLEARM @FIGTB2(A) + AOBJN A,.-1 + PUSHJ P,FILGET ;WHAT SHOULD I FIND? + PUSHJ P,DEVGET ;WHERE SHOULD I LIST THEM? + SKIPE OFINDF + JRST FLOOP1 +;HERE FIND FROM DISK + .CORE CORSZB + JRST .-1 + MOVEI C,SBUF ;HUGE BUFFER AT END OF CORE + + MOVSI V,-NTDIR ;ONCE FOR EACH TAPE DIRECTORY POSSIBLY ON DISK + SKIPE DFINDF ;IF THIS IS FOR A DECEASED ITS + MOVSI V,-NDDIR ; USE DIFFERENT DIRECTORIES. + +FLOOP: SKIPE DFINDF + JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH + DEDDEV ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] + DDIRTB(V)] + JRST NEXDIR + JRST FLSNRF] + SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH + [SIXBIT /DSK/] ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] + TDIRTB(V)] + JRST NEXDIR ;DIR PROBABLY DOESNT EXIST +FLSNRF: MOVE A,[-2000,,FDIRBF] + .IOT UFDCH,A ;SNARF DIR + .CLOSE A, + + MOVE A,FDIRBF+UDNAMP ;PROCESS THE DIR, MAKING A LIST OF TAPE FILES IN SBUF + ADDI A,FDIRBF ;A POINTS TO BEGINNING OF NAME AREA +FINDNM: CAILE A,FDIRBF+1777-4 + JRST NEXDIR ;END OF NAME AREA + SKIPE W,(A) ;EMPTY SLOT + CAME W,[SIXBIT /TAPE/] ;KEEP ONLY "TAPE XXX" FILES + JRST FNDNEX + MOVE B,UNRNDM(A) + TLNN B,UNLINK ;IGNORE FILES IN USE AND OTHER CHIMERAS + TLNE B,UNIGFL + JRST FNDNEX ; FILE IS LINK, OPEN FOR WRITING OR BEING DELETED + MOVEM W,(C) ;FIRST NAME + MOVE W,1(A) + MOVEM W,1(C) ;SECOND NAME + MOVE W,TDIRTB(V) + MOVEM W,2(C) ;TAPE DIR NAME (FOR USE IN OPEN LATER) + MOVE W,3(A) + MOVEM W,3(C) ;CREATION DATE + HLRZ W,4(A) ;REFERENCE DATE (NOT REALLY USED IN FIND) + SKIPN W + MOVEI W,177777 + ANDI W,177777 + MOVSM W,4(C) + ADDI C,LUNBLK ;MOVE TO NEXT NAME ENTRY IN OUTPUT BUFFER +FNDNEX: ADDI A,5 ;MOVE TO NEXT ENTRY IN DIRECTORY + JRST FINDNM +NEXDIR: AOBJN V,FLOOP ;MOVE TO NEXT DIR IN .TAPE* LIST + MOVEM C,LFDIR ;LAST ENTRY ADDED TO LIST + +;NOW SORT ACCUMULATED FILE POINTERS BY CREATION DATE + MOVEI A,SBUF ;SORT BETWEEN SBUF AND C(LFDIR) + MOVEI N,3 ; THIRD ELEMENT IS SORT KEY (CDATE) + MOVEI D,LUNBLK ; ENTRIES ARE NAME PTRS + PUSHJ P,SORTDN ; SORT IN DESCENDING ORDER + + MOVEI A,SBUF + MOVEM A,DIRIDX ;POINTER TO TAPE FILE WE ARE WORKING ON +NEXFL1: PUSHJ P,NEXTAP ;SET UP FILE OPEN BLOCK + JRST CRR ; NO MORE TAPES TO LOOK AT + PUSHJ P,NEXFL3 ;PROCESS TAPE FILE + JRST NEXFL1 + +NEXTAP: MOVE A,DIRIDX ;ROUTINE TO SET UP OPEN BLOCK FOR TAPE FILE SEARCH + SKIPN B,(A) + POPJ P, ;NO MORE FILES + MOVEM B,FN1 + MOVE B,1(A) + MOVEM B,FN2 + MOVE B,2(A) + .SUSET [.SSNAM,,B] + ADDI A,LUNBLK + MOVEM A,DIRIDX + AOS (P) + POPJ P, + +;FIND FROM TAPE FILES DUMPED TO MAG TAPE +; USES SAME SEARCHING CODE ONCE FILE IS "OPEN", BUT IS OTHERWISE +; COMPLETELY SEPARATE FROM REGULAR FIND COMMAND +FLOOP1: PUSHJ P,MAGOP ;READ TAPE + JRST FLOOP2 + MOVE A,HFN1 + MOVEM A,FN1 + MOVE A,HFN2 + MOVEM A,FN2 + PUSHJ P,NEXFL5 ;PROCESS THIS FILE NAME + PUSHJ P,FILSKP ;SKIP FILE + JRST FLOOP1 + +FLOOP2: PUSHJ P,ARWND ;REWIND TAPE AND EXIT + JRST CRR + +;HERE FOR EACH TAPE DIRECTORY ON DISK OR TAPE +NEXFL3: SKIPE DFINDF + JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,DSKIN + DEDDEV ? FN1 ? FN2 ? SNAME] + JRST RET + JRST NEXFL5 ] + OPEN DSKIN,TRNI ;OPEN TAPE DIRECTORY + JRST RET + +NEXFL5: SETOM EOFF + MOVEI B,0 ;SO THAT GWD WILL .IOT IMMEDIATELY THE FIRST TIME THROUGH + JSR GWDF + MOVE C,A + JSR GWDF + AOBJN C,.-1 ;SKIP TAPE HEADER + MOVE C,A + SETZM FILN +COMPR: JSR GWDF + SKIPN A + JRST FNDSSN + AOS FILN + MOVEM A,PFF1 + JSR GWDF + MOVEM A,PFF2 + ADD C,[2,,2] ;WE JUST READ TWO WORDS + MOVE W,LENGTH + IMUL W,[-1,,] +COMCON: SKIPN D,FMSNM(W) + JRST COMFN1 ;ZERO MATCHES TO ANYTHING + CAME D,PSNAM + JRST NEXCOM ;NO MATCH +COMFN1: SKIPN D,FMFN1(W) + JRST COMFN2 + CAME D,PFF1 + JRST NEXCOM +COMFN2: SKIPE D,FMFN2(W) + CAMN D,PFF2 + JRST MATCH +NEXCOM: AOBJN W,COMCON +NEXNAM: JUMPGE C,INITC ;ALREADY CORRECT PLACE + JSR GWDF + AOBJN C,.-1 ;GET TO BEGINNING OF NEXT ENTRY +INITC: IMUL C,[-1,,] + JRST COMPR + +FNDSSN: JSR GWDF + MOVEM A,PSNAM + JRST COMPR + +;HERE WHEN THE FILE NAME MATCHES, LIST THIS ONE. +MATCH: JSR GWDF ;READ DATE AND TIME + PUSH P,B + MOVEM A,DAYTIM + ADD C,[1,,1] + PUSHJ P,CRR + PSIS FN1 + PSIS FN2 + PSIS PSNAM + PSIS PFF1 + PSIS PFF2 + PDPT FILN + PASC [ASCIZ / /] + PUSHJ P,PFDATE + POP P,B + JRST NEXNAM + +PFDATE: MOVE A,DAYTIM ;PRINTS CONTENTS OF DAYTIM AS FILE CREATION DATE AND TIME + AOJE A,NODATE + CAMN A,[SETZ] + JRST LDATE + LDB A,[270400,,DAYTIM] ;CREATION DATE AND TIME + PUSHJ P,DPT ;PRINT MONTH + PASC [ASCIZ \/\] + LDB A,[220500,,DAYTIM] + PUSHJ P,DPT ;PRINT DAY + PASC [ASCIZ \/\] + LDB A,[330700,,DAYTIM] + PUSHJ P,DPT + HRRZ A,DAYTIM ; TIME + PASC [ASCIZ / /] + IDIVI A,60.*60.*2 ;HALF SECONDS IN AN HOUR + PUSHJ P,DDPA ;PRINT HOURS + PRINT : + MOVE A,B + IDIVI A,60.*2 ;HALF SECONDS IN A MINUTE + PUSHJ P,DDPA ;PRINT MINUTES + PRINT : + MOVE A,B + IDIVI A,2 ;HALF SECONDS IN A SECOND + PUSHJ P,DDPA ;PRINT SECONDS + CAIE B,0 ;RG MEMORIAL (?) HALF SECOND OF SILENCE + PRINT .5 + POPJ P, + +NODATE: PRINT - + POPJ P, + +LDATE: PRINT L + POPJ P, + +DDPA: CAIGE A,10. ;SHOULD WE PRINT A '0' AS IN 4:07? + PRINT 0 + PUSH P,B + PUSHJ P,DPT + POP P,B + POPJ P, + +GWD: 0 +GWD1: MOVE A,(B) ;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT + AOBJN B,[JRST @GWD] ;NO NEED TO READ FROM DISK YET(MORE IN BUFFER) + SKIPL EOFF + JRST CPOPJ ;END OF FILE, RETURN FROM CALLER!!!! + MOVE B,[-2000,,BUF] + .IOT DSKIN,B + SUBI B,BUF-1 ;SO ONE WORD BUFFER WILL WIN + MOVNS B + HRLS B + HRRI B,BUF + CAME B,[-2000-1,,BUF] ;FULL BUFFER? + AOS EOFF ;NO, MUST BE LAST BUFFER IN FILE + JRST GWD1 ;NOW GET THE WORD + +GWDF: 0 ;FOR FIND, GWD FROM DISK OR TAPE + SKIPN OFINDF + JRST GWDFD +GWDFM: JSR MGWD + JRST @GWDF + +GWDFD: JSR GWD + JRST @GWDF + +MGWD: 0 +MGWD1: MOVE A,(B) ;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT + AOBJN B,[JRST @MGWD] ;NO NEED TO READ FROM DISK YET(MORE IN BUFFER) + SKIPL EOFF + JRST CPOPJ ;END OF FILE + MOVE A,[-2000,,BUF] + PUSHJ P,MAGREAD + JRST FILSKP ;ERROR, SKIP TO END OF FILE AND CONTINUE + MOVE B,A + SUBI B,BUF-1 ;SO ONE WORD BUFFER WILL WIN + MOVNS B + HRLS B + HRRI B,BUF + CAME B,[-2000-1,,BUF] ;FULL BUFFER? + AOS EOFF ;NO, MUST BE LAST BUFFER IN FILE + JRST MGWD1 ;NOW GET THE WORD + SUBTTL MISCELLANEOUS MAGTAPE OPERATIONS + +;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE +CLSOUT: SKIPL TAPTYP + JRST [ .CLOSE MAGOUT, ;CLOSE TAPE OUTPUT + POPJ P, ] + PUSHJ P,RMTEOF ;Write a second EOF mark + SETOM CTRLG ;Defer ^G + PUSHJ P,RTAPE"FINISH ;Make sure all output was completed + JRST RMTWER ;Tape error + JRST CTRLGX ;Don't close RTAPE server yet + +;WRITE EOF,MAGOUT ASUMED OPEN +AEOF: SKIPGE TAPTYP + JRST RMTEOF + MOVEI A,5 + MOVEM A,MTCMD + MOVE A,[MAGOUT,,MTCMD] + .MTAPE A, + JRST NAUGHT + POPJ P, + +RMTEOF: SETOM CTRLG + PUSHJ P,RTAPE"WRTFM ;Write file mark + JRST CTRLGX + +;SPACE TO LOGICAL END OF TAPE +AEOT: MOVEI A,10 + PUSHJ P,TAPOPR + SETOM EOTFLG + SETOM UFDDAT + SETOM MFDDAT + CLEARM ITAPE + POPJ P, + +;SPACE REVERSE FILE +SPRF: MOVE A,[-1,,7] + JRST TAPOPR + +;SPACE FORWARD FILE +SPFF: MOVEI A,7 + JRST TAPOPR + +;REWIND +ARWND: SKIPA B,[1] ;SKIPS THROUGH + +;REWIND THEN UNLOAD +AUNLD: MOVEI B,2 + SETOM ITAPE + SETOM UFDDAT + SETOM MFDDAT + SKIPL A,THTPN + MOVEM A,LTHTPN + SETOM THTPN + MOVE A,B + PUSHJ P,TAPOPR + CLEARM EOTFLG + POPJ P, + +;PERFORM A TAPE OPERATION, COMMAND CODE IN A +TAPOPR: SKIPGE TAPTYP + JRST RMTOPR +LCLOPR: OPEN MAGIN,MAGI + JRST RET + MOVEM A,MTCMD + MOVE A,[MAGIN,,MTCMD] + .MTAPE A, + JRST NAUGHT + .CLOSE MAGIN, + POPJ P, + +;This just initiates the operation +;Call SETIT1 if you want to know if it worked +RMTOPR: PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,A + PUSHJ P,SETIT1 ;Terminate any pending read-ahead + POP P,A + SETOM CTRLG + XCT RMTDIS(A) + POP P,D + POP P,C + POP P,B + JRST CTRLGX + +RMTDIS: .VALUE + PUSHJ P,RTAPE"REWIND + PUSHJ P,RTAPE"UNLOAD +REPEAT 4,.VALUE + PUSHJ P,[ HLRE B,A ;7 space file + JRST RTAPE"SKPFL0 ] + PUSHJ P,[ MOVSI B,20000 ;10 space to eot + JRST RTAPE"SKPFL0 ] + +;ROUTINE TO DETERMINE WHETHER USER IS SURE +CHECK: PUSH P,LPTSW + SETZM LPTSW + PUSHJ P,CRR + PRINT ARE YOU SURE ? +CHECK2: PUSHJ P,TYI + CAIE A,"Y + JRST ERR + PUSHJ P,CRR + POP P,LPTSW + POPJ P, + +;Show who used tape drive last. Put this on .TAPE0. That's ok, +;since FIND ignores files that aren't "TAPE XXX." +SETITN: .suset [.runame,,a] + .rdate d, + .call [setz + sixbit /MLINK/ + [sixbit /DSK/] + [sixbit /LAST/] + [sixbit /USE/] + [sixbit /.TAPE0/] + COMT(B) ;which command + D ;when + SETZ A] ;who + jfcl +;Drops in. +;SET ITAPE ROUTINE +;Call here first time tape is used +SETIT: SKIPE TAPTYP ;Do we know what type of drive to use? + JRST SETIT0 ;Yes + .OPEN MAGIN,MAGI ;No, see if there is a local drive + JRST [ .SUSET [.RIOS+MAGIN,,A] + LDB A,[220600,,A] + CAIE A,%ENSDV + JRST .+1 + SETOM TAPTYP ;Use remote drive + JRST SETIT0 ] + AOS TAPTYP ;Default is local drive if it exists +SETIT0: PUSHJ P,SETIT1 ;Get tape status in A and in TAPEF + TRNN A,TF%BOT ;Check for BOT + POPJ P, ;No + SETOM ITAPE ;Yes, at BOT + SETOM UFDDAT + SETOM MFDDAT + POPJ P, + +SETIT1: SKIPGE A,TAPTYP ;Remote tape? + JRST SETIT2 ;Yes +SETIT4: OPEN MAGIN,MAGI ;WAIT FOR ALL TAPE ACTIVITY TO STOP + JRST RET ;BARF +IFN NEWCOD, .STATUS MAGIN,TAPEF + .CLOSE MAGIN, +IFE NEWCOD, CONI 344,TAPEF ;READ MAG TAPE STATUS + MOVE A,TAPEF + POPJ P, + +;Mount remote tape if not already mounted +SETIT2: PUSHJ P,RTAPE"RDRST ;Reset read and write buffers, stop readahead + AOJL A,RMTSTS ;Jump if already mounted + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + PUSH P,N + PUSH P,SYM + PUSH P,TER + SKIPE TAPHST ;Host known yet? + JRST SETIT3 + PRINT TAPE SERVER HOST= + PUSHJ P,GETSYL + JRST ERR + PUSH P,SYM + PRINT DRIVE= + PUSHJ P,GETSYL + JRST ERR + MOVE B,[440700,,TAPDRV] + PUSHJ P,SIXTO7 + POP P,SYM + MOVE B,[440700,,TAPHST] + PUSHJ P,SIXTO7 + PRINT [READ-ONLY? ] ;HT server insists + PUSHJ P,TYI + MOVE SYM,[ASCII/BOTH/] + CAIN A,"Y + MOVE SYM,[ASCII/READ/] + MOVEM SYM,TAPDIR + PUSHJ P,CRR +SETIT3: MOVEI A,TAPHST + MOVEI B,CORSZB_10. + MOVEI C,TAPDRV + MOVEI D,TAPDIR + SETOM CTRLG + PUSHJ P,RTAPE"OPEN + JRST [ SETZM LPTSW + PRINT [Remote mount failed: ] + PASC RTAPE"STATUS ;Just the string is enough + SETZM TAPHST ;Don't save host if failed to connect + JRST MLP ] +;Develop tape status in A and TAPEF +RMTST1: MOVE B,RTAPE"STSFLG + MOVEI A,TF%RDY + TRNE B,RTAPE"F%BOT + TRO A,TF%BOT + TRNE B,RTAPE"F%EOT + TRO A,TF%EOT + TRNE B,RTAPE"F%EOF + TRO A,TF%EOF + TRNN B,RTAPE"F%OFFL + TRNN B,RTAPE"F%MNT + TRZ A,TF%RDY + MOVEM A,TAPEF + SETOM TAPTYP ;If not mounted, forget about this server + TRNE A,TF%RDY + SOS TAPTYP ;Mounted + TRNE B,RTAPE"F%STRG + JRST [ PUSH P,LPTSW + SETZM LPTSW + PRINT Remote tape status= + PASC RTAPE"STATUS + PUSHJ P,CRR + POP P,LPTSW + JRST .+1 ] + POP P,TER + POP P,SYM + POP P,N + POP P,E + POP P,D + POP P,C + POP P,B + JRST CTRLGX + +;Tape already mounted, check status +;Develop tape status in A and TAPEF +RMTSTS: PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + PUSH P,N + PUSH P,SYM + PUSH P,TER + SETOM CTRLG + PUSHJ P,RTAPE"PROBE + JRST RMTST1 + +;Remote login routine +RMTLGN: SKIPN RMTUSR ;First try own name and no password + JRST [ .SUSET [.RXUNAME,,SYM] + MOVE B,[440700,,RMTUSR] + PUSHJ P,SIXTO7 + JRST .+1 ] +RMTLG1: MOVEI A,RMTUSR + MOVEI B,RMTPSW + PUSHJ P,RTAPE"LOGIN + CAIA + POPJ P, + PRINT [_REMOTE LOGIN AS ] + PASC RMTUSR + PRINT [ FAILED: ] + PASC RTAPE"STATUS + PUSHJ P,CRR + PASC TAPHST + PRINT [ USER ID=] + PUSHJ P,GETSYL + JRST MLP + MOVE B,[440700,,RMTUSR] + SKIPE SYM ;DON'T CHANGE USER ID IF BLANK INPUT + PUSHJ P,SIXTO7 + MOVE A,TTYST1 ;TURN ECHOING OFF + ANDCM A,[<%TGPIE+%TGMPE>*010101010101] + MOVE B,TTYST2 + ANDCM B,[<%TGPIE+%TGMPE>*010101010101] + .CALL [ SETZ ? 'TTYSET ? MOVEI TYIC ? A ? B ? SETZ TTYSTS ] + JFCL + PRINT PASSWORD= + PUSHJ P,GETSYL + JRST MLP + .CALL TTYSET ;TURN ECHOING BACK ON + JFCL + MOVE B,[440700,,RMTPSW] + PUSHJ P,SIXTO7 + JRST RMTLG1 + +SIXTO7: MOVEI N,0 ;Sixbit in SYM to ASCIZ, BP in B + LSHC N,6 + ADDI N,40 + IDPB N,B + JUMPN SYM,SIXTO7 + IDPB SYM,B + POPJ P, + +;Commands to specify tape drive to use +AREMOTE:SKIPA A,[-1] +ALOCAL: MOVEI A,1 + MOVEM A,TAPTYP + .CLOSE RTAPE"RSICH, ;Dispose of possible remote server + .CLOSE RTAPE"RSOCH, + SETZM TAPHST ;Force ask for host again + PUSHJ P,SETIT1 ;Get tape status in A and in TAPEF + SKIPGE TAPTYP + PRINT [REMOTE ] + SKIPLE TAPTYP + PRINT [LOCAL ] + PRINT TAPE + TRNE A,TF%BOT ;Check for BOT + JRST ALOCL1 + PRINT [ NOT REWOUND] + TRNN A,TF%RDY ;Check for offline + JRST ALOCL2 ;If offline, leave ITAPE alone so quit works + SETZM ITAPE + POPJ P, + +ALOCL1: PRINT [ REWOUND] + SETOM ITAPE + SETOM UFDDAT + SETOM MFDDAT + POPJ P, + +ALOCL2: PRINT [ AND NOT ON-LINE] + POPJ P, + +;COMMAND TO SPACE TAPE, LISTING FILES, AND WAITING FOR A SPACE +; AFTER EACH +ALSPACE:PUSHJ P,CRR + PUSHJ P,TYOS +ASPAC2: PUSHJ P,LAST + POPJ P, + PUSHJ P,TYI + CAIN A,177 + POPJ P, + JRST ASPAC2 + +;COMMAND TO SPACE TAPE FORWARD OR BACKWARD 'N' FILES +ASPACE: SETZM N + CAIN TER,15 + JRST ASPAC1 + PUSHJ P,GETSYL + POPJ P, +ASPAC1: MOVEI A,7 + ADDM N,ITAPE + SKIPGE ITAPE + SETOM ITAPE + SKIPGE N + SOS N ;SPACE REVERSE + HRL A,N + PUSHJ P,TAPOPR + PUSHJ P,SETIT1 ;Await completion and get tape status + TRNN A,TF%BOT ;Unless BOT, + SKIPL N ;SPACING BACKWARD? + POPJ P, + JRST SPFF ;NOW SPACE FILE FORWARD + SUBTTL GET TAPE NUMBER, LISTING DEVICE + +TAPGET: PUSH P,LPTSW +TAPGT1: SETZM LPTSW + PRINT TAPE NO= + PUSHJ P,GETSYL + JRST TAPGT1 + JUMPL N,TAPGT1 + SKIPE WRONG + DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine + CAIL N,MAXTAP + JRST TAPGT1 + POP P,LPTSW + HRLM N,THTPN + SETZM NPLACE + MOVEM SYM,NSVTPN + MOVEM SYM,GFRLNK+4 + SKIPN LPTSW + JRST SNPLAC + PRINT TAPE NO = + PDPT N + PASC [ASCIZ / /] + .RDATE A, + MOVEM A,THDATE + PRINT CREATION DATE + PSIS THDATE + PASC [ASCIZ / /] + PRINT DUMPED BY + .SUSET [.RXUNAME,,A] + PSIS A + JRST SNPLAC ;DECIDE WHERE TO PUT .TAPEn FILE + +ATPLA: HRRZ A,LPTO + CAIN A,(SIXBIT /TPL/) + JRST NAUGHT + PRINT CHANGED TO TPL_ + MOVEI SYM,(SIXBIT /TPL/) + JRST SETOU1 + +DEVGET: PRINT LIST DEV = +SETOUT: PUSHJ P,GETSYL ;READ DEVICE TO BE USED FOR LISTING STUFF ON + JRST DEVGET + HLRZS SYM + SKIPN SYM + MOVEI SYM,'TTY ;RESPONSE OF CR MEANS TTY + CAIN SYM,'TTY + POPJ P, +SETOU1: HRRM SYM,LPTO + .SUSET [.SSNAM,,MYNAME] ;WRITE ON USER'S WORKING DIR + OPEN LPTCH,LPTO ;LIST FILES ON TAPE + JRST ATPLA + SETOM LPTSW ;SET LPT SWITCH ON + POPJ P, + SUBTTL DECIDE WHERE TO PUT .TAPEn; TAPE nnn FILE + +;THIS IS A TABLE OF THE NAMES OF ALL THE TAPE DIRECTORIES +TDIRTB: REPEAT 10., +.RPCNT + REPEAT 26., +.RPCNT +NTDIR==.-TDIRTB + + +;HERE IS A SORT OF KLUDGE TO EXAMINE THE TAPE DIRECTORIES OF A +;DECEASED ITS (IN THIS CASE, AI.) RESTORE ALL THE TAPE +;DIRECTORIES TO SOME MACHINE, UNDER THE NAMES %TAPEn;. + +DFINDF: 0 ;-1 => LOOKING ON DECEASED MACHINE'S TAPE DIRS. +DEDDEV: SIXBIT /DM/ ;MACHINE WHERE %TAPEn DIRS ARE STORED. +DEDITS: SIXBIT /AI/ ;WHICH MACHINE'S TAPE DIRS THEY WERE. + +DDIRTB: REPEAT 10., +.RPCNT + REPEAT 26., +.RPCNT +NDDIR==.-TDIRTB + + + +SNPLAC: SKIPN NPLACE ;IF ALREADY KNOW, DON'T MAKE INFINITE SYSTEM CALLS + JRST SNPL0 + .SUSET [.SSNAME,,NPLACE] + POPJ P, + +SNPL0: PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + HLRZ A,THTPN + MOVE D,NSVTPN + CAIE A,-1 + JRST SNPL00 + HLRZ A,LTHTPN + MOVE C,[440600,,D] + MOVEI D,0 + PUSHJ P,SIXNUM +SNPL00: MOVEM D,SNTRYN + SETOB B,C ;B NAME OF LEAST FULL DIR, C SPACE LEFT IN IT + MOVSI A,-NTDIR +SNPL1: .CALL SNTRY ;IS TAPE IN THIS DIR? + JRST [ CAIN E,4 + JRST SNPL3 ;NO + CAIN E,20 + JRST SNPL2 ;NON-EXISTENT DIRECTORY + PRINT ERROR ACCESSING TAPE DIR - + PUSHJ P,OPINFL + JRST SNPL3 ] + MOVE B,TDIRTB(A) + JRST SNPL4 ;YES, LEAVE IN SAME DIR + +SNPL3: MOVE E,TDIRTB(A) ;READ DIR TO SEE HOW FULL IT IS + .SUSET [.SSNAME,,E] + .OPEN SNPLCH,FNO + .LOSE %LSFIL + MOVE D,[-UDNAMP-1,,SNBUF] + .IOT SNPLCH,D + CAML C,SNBUF+UDNAMP + JRST SNPL3A + MOVE C,SNBUF+UDNAMP ;THIS DIR LESS FULL + MOVE B,TDIRTB(A) +SNPL3A: AOBJN A,SNPL1 ;TRY NEXT DIR +SNPL2: CAIL C,460 + JRST SNPL4 ;THIS ONE HAS ENOUGH SPACE + JUMPL A,SNPL2A + SETZM LPTSW + DIE ALL TAPE DIRECTORIES FULL + +SNPL2A: MOVE E,TDIRTB(A) + .SUSET [.SSNAME,,E] + .OPEN SNPLCH,CRUFD ;BEST DIR IS GROSSLY FULL, CREATE A NEW ONE + JFCL + .SUSET [.RIOS+SNPLCH,,C] + LDB C,[220600,,C] + CAIE C,4 ;ERROR CODE BETTER BE FILE NOT FOUND! + JRST [ SETZM LPTSW + DIE [NO FREE UFD SLOTS, CANNOT CREATE ANOTHER TAPE DIRECTORY, GET HELP] + ] + MOVE B,TDIRTB(A) +SNPL4: MOVEM B,NPLACE ;USE THIS DIR + .SUSET [.SSNAME,,NPLACE] + .CLOSE SNPLCH, + POP P,E + POP P,D + POP P,C + POP P,B + POP P,A + POPJ P, + SUBTTL TAPE LISTING COMMANDS + +;QUIT COMMAND +AQUIT: .BREAK 16,160000 + +;LIST CONTENTS OF A TAPE BY USING .TAPEn FILE +ATLIST: PUSHJ P,DEVGET + PUSHJ P,TAPGET + PUSHJ P,SNPLAC ;FIND WHICH TAPE DIR TO USE + MOVEI A,.BII + HRLM A,NSVOP + .OPEN SAVET,NSVOP + CAIA + JRST ATLST4 + PRINT NOT FOUND + JRST RET + +ATLST4: SETZM ITAPE + MOVE A,[-1,,B] + .IOT SAVET,A + ADD B,[1,,THBLK+1] + .IOT SAVET,B + PUSHJ P,PTHEAD + MOVE A,[-1,,GARBAG] + .IOT SAVET,A +ATLST1: HRROI A,B + .IOT SAVET,A + JUMPL A,ATLST2 + SKIPN B + JRST ATLST3 + MOVEM B,HBLK+2 + HRROI A,HBLK+3 + .IOT SAVET,A + JUMPL A,ATLST2 + HRROI A,HBLK+5 + .IOT SAVET,A + JUMPL A,ATLST2 + PUSHJ P,LOUSY + JFCL + AOS ITAPE + JRST ATLST1 + +ATLST2: SETOM ITAPE + SETOM MFDDAT + SETOM UFDDAT + .CLOSE SAVET, + POPJ P, + +ATLST3: HRROI A,HBLK+1 + .IOT SAVET,A + JRST ATLST1 + +APTDIR: SETOM PDIRSW ;PRINT DIRECTORIES FROM TAPE. + PUSHJ P,DEVGET + PUSHJ P,APTD1 + POPJ P, + JRST .-2 + +APTD1: PUSHJ P,MAGOP + POPJ P, + PUSHJ P,FILSKP + AOS (P) + POPJ P, + +ALIST: PUSHJ P,DEVGET ;LIST FILES ON MACRO-TAPE + PUSHJ P,LAST + POPJ P, + JRST .-2 + +LAST: PUSHJ P,LOUSE + POPJ P, + PUSHJ P,FILSKP ;FLUSH REST OF FILE (PITY WE HAVE TO READ ALL THIS CRUFT) + AOS (P) + POPJ P, + +;SAVE STUFF ABOUT THIS TAPE IN SYSENG; MACRO TAPES FILE + +SINFO: IRPS X,,[THTPN THTYPE FUSNM LUSNM]Y,,[STAPEN STYPE SFUSNM SLUSNM] + MOVE A,X + MOVEM A,Y +TERMIN + MOVE A,THTPN + CAME A,[-1] + JRST SINFO5 + MOVE A,LTHTPN + MOVEM A,STAPEN +SINFO5: .RDATE A, + MOVEM A,STDATE +SINFO1: .SUSET [.RUNAME,,SUSER] + .SUSET [.SSNAM,,SPLACE] +SINFO4: MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE + HRLM A,STATOP + .OPEN STATC,STATOP + JRST SINFO2 + .CALL CLBIT ;ZERO DUMPCHECK BIT + JFCL + HLRZ A,STAPEN + SKIPE WRONG + DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine + CAIL A,MAXTAP + DIE [TAPE NUMBER TOO LARGE, YOU LOSE] + IMULI A,TPINFL ;ACCESS TAPE INFO BLOCK + .ACCESS STATC,A + MOVE A,[-TPINFL,,STAPST] + .IOT STATC,A + .CLOSE STATC, + .SUSET [.SSNAM,,USNM] + POPJ P, + +SINFO2: MOVEI A,.BIO ;MACRO TAPES DOESN'T EXIST, CREATE IT + HRLM A,STATOP + OPEN STATC,STATOP + JRST RET + SETZM BUF + MOVE A,[BUF,,BUF+1] + BLT A,BUF+TPINFL-1 + SKIPE WRONG + DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine + MOVEI B,MAXTAP +SINFO3: MOVE A,[-TPINFL,,BUF] + .IOT STATC,A + SOJG B,SINFO3 + .CLOSE STATC, + JRST SINFO4 + +;GET INFO ON A TAPE OUT OF SYSENG; MACRO TAPES FILE +GINFO: MOVEI B,.BII + HRLM B,STATOP + .SUSET [.SSNAM,,SPLACE] + .OPEN STATC,STATOP + JRST GINFO1 + SKIPE WRONG + DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine + CAIL N,MAXTAP + DIE [TAPE NUMBER TOO LARGE, YOU LOSE] + IMULI N,TPINFL + .ACCESS STATC,N + MOVE A,[-TPINFL,,STAPST] + .IOT STATC,A + .CLOSE STATC, +GINFO2: .SUSET [.SSNAM,,USNM] + POPJ P, + +GINFO1: SETZM STAPST + MOVE A,[STAPST,,STAPST+1] + BLT A,STAPST+TPINFL-1 + JRST GINFO2 + +;COMMAND TO LIST ALL KNOWN TAPES +ATAPES: PUSHJ P,DEVGET + .SUSET [.SSNAM,,SPLACE] + MOVEI A,.BII + HRLM A,STATOP + OPEN STATC,STATOP + JRST RET + MOVEI U,0 +TAPES1: MOVE A,[-TPINFL,,STAPST] + .IOT STATC,A + SKIPE STAPEN + PUSHJ P,LINFO + ADDI U,1 + SKIPE WRONG + DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine + CAIGE U,MAXTAP + JRST TAPES1 + .CLOSE STATC, + JRST CRR + +;COMMAND TO LIST A SINGLE TAPE +ATAPE: PUSHJ P,TAPGET + PUSHJ P,GINFO + PUSHJ P,LINFO + JRST CRR + +;LIST OUT MACRO TAPES INFO +LINFO: HLRZ A,STAPEN + JUMPE A,NOINFO + PDPT A + PSIS STDATE + SKIPN STYPE + PRINT NORM + SKIPGE STYPE + PRINT INCR + SKIPLE STYPE + PRINT FULL + PSIS SUSER + SKIPN SDONE + PRINT ABRT + SKIPLE SDONE + PRINT ARCH + SKIPGE SDONE + PRINT DUMP + HRRZ A,STAPEN + PDPT A + PRINT + PSIS SFUSNM + PSIS SLUSNM + JRST CRR + +NOINFO: PRINT NO INFORMATION + JRST CRR + +;CREATE TAPE DIRECTORY ON DISK FROM MOUNTED TAPE +ATAPED: PUSHJ P,ARWND + PUSHJ P,MAGOP + POPJ P, + MOVE A,THTPN + MOVEM A,LTHTPN + SETOM THTPN ;KNOWN NUMERICALLY, NOT SYMBOLICALLY + SETZM NPLACE + PUSHJ P,SNPLAC ;FIND TAPE DIRECTORY IF ON-LINE ALREADY + MOVEI A,.BII ;OTHERWISE DECIDE WHERE TO PUT IT + HRLM A,NSVOP + .OPEN SAVET,NSVOP + JRST ATAPD3 + PRINT _DIRECTORY ALREADY EXISTS._ + PUSHJ P,CHECK +ATAPD3: MOVEI A,.BIO + HRLM A,NSVOP + OPEN SAVET,NSVOP + JRST RET + MOVE A,[-LTHBLK,,THBLK] ;STORE TAPE HEADER + .IOT SAVET,A + HRROI A,[-3,,0] + .IOT SAVET,A + SETOM USNM +DLUP: PUSHJ P,FILSKP ;SKIP THIS TAPE FILE + PUSHJ P,MAGOP ;GET NEXT + POPJ P, ;EOT + MOVE B,USNM + CAME B,HBLK+1 ;NEW S NAME? + PUSHJ P,DLUPSN ;YES. + MOVE A,[-2,,HBLK+2] ;FILE NAMES + .IOT SAVET,A + MOVE A,[-1,,HBLK+5] ;DATE + .IOT SAVET,A + JRST DLUP + +DLUPSN: MOVE A,HBLK+1 ;SWITCH S NAMES + MOVEM A,USNM + HRROI A,[0] ;0 FN FLAGS SNAME CHANGE + .IOT SAVET,A + HRROI A,USNM + .IOT SAVET,A + POPJ P, + +;COMMAND TO CHANGE STORED INFO ABOUT A TAPE +TAPSET: PUSHJ P,TAPGET ;GET TAPE NUMBER + MOVE U,N + PUSHJ P,GINFO + PUSHJ P,LINFO + HRLM U,STAPEN +LWREQ: PRINT LAST WRITTEN= + PUSHJ P,GETSYL + JRST LWREQ + CAIN A,33 + JRST TAPST1 + SKIPE SYM + MOVEM SYM,STDATE + PRINT TYPE= + PUSHJ P,TYI + MOVEI C,1 + CAIN A,33 + JRST TAPST1 + CAIN A,"F + MOVEM C,STYPE + CAIN A,"R + SETZM STYPE + CAIN A,"I + SETOM STYPE + PRINT _ARCHIV? + PUSHJ P,TYI + CAIN A,"Y + MOVEM C,SDONE + CAIN A,"N + SETOM SDONE + SKIPN STYPE + JRST TAPST1 +RNFULU: PRINT _REEL NO FIRST USER LAST USER +BACK: PUSHJ P,GETSYL + JRST RNFULU + CAIN A,33 + JRST TAPST1 + MOVEM SYM,W + SKIPE SYM + HRRM N,STAPEN +BACK1: PUSHJ P,GETSYL + JRST UNDO1 + CAIN A,33 + JRST TAPST1 + SKIPE SYM + MOVEM SYM,SFUSNM + PUSHJ P,GETSYL + JRST UNDO2 + SKIPE SYM + MOVEM SYM,SLUSNM +TAPST1: PUSHJ P,CHECK + JRST SINFO1 + +UNDO1: PSIS W + PUSHJ P,TYOS + JRST BACK + +UNDO2: PSIS SYM + PUSHJ P,TYOS + JRST BACK1 + +;MORE LISTING COMMANDS AND SUBROUTINES + +LOUSE: PUSHJ P,MAGOP ;OPEN TAPE AND READ HEADER + JRST ENDMAG ;END OF TAPE +LOUSY: PUSHJ P,CRR + PUSHJ P,TAPN + PSIS HSNM + PSIS HFN1 ;OUTPUT FILE NAME + PSIS HFN2 + SKIPE LNKFLG + PUSHJ P,LDMUT5 + SKIPE LNKFLG + JRST NOPP + SKIPL HPKN + PDPT HPKN ;OUTPUT PACK NUMBER +NOPP: SIXTYP [SIXBIT/ /] + MOVE A,HDATE + MOVEM A,DAYTIM + SKIPN LNKFLG + PUSHJ P,PFDATE + AOS (P) + POPJ P, + +ENDMAG: PRINT _ REEL = + HRRZ A,THTPN + PDPT A ;OUTPUT REEL NUMBER + JRST CRR + +;COMMAND TO LIST THE MFD +AMFD: PUSHJ P,DEVGET + SETOM MFDIN +AMFD1: PUSHJ P,MFDN + POPJ P, + PSIS USNM + PUSHJ P,CRR + JRST AMFD1 + +;COMMAND TO LIST A DIRECTORY +ALISTF: SETOM FLNI + CLEARM MICFLG + MOVEI A,(SIXBIT /DSK/) + HRRM A,FNO +GETDIR: PRINT DIRECTORY= + PUSHJ P,GETSYL + JRST GETDIR + CAIN TER,15 + PUSHJ P,CRR + CAIN TER,": + HLRM SYM,FNO + MOVEM SYM,USNM + CAIE TER,": + .SUSET [.SSNAM,,USNM] + PUSHJ P,DEVGET ;WHERE TO LIST IT TO +ALISTK: PUSHJ P,FNG + JRST CRR + PUSHJ P,CRR + PSIS FN1 + PSIS FN2 + SKIPN MICFLG + PDPT PACKN + JRST ALISTK + +;LISTING ROUTINES + +;LIST LINK INFO +LDMUT5: PSIS [SIXBIT /L/] + PSIS PACKN ; SYSNM + PSIS LNKNM1 + PSIS LNKNM2 + POPJ P, + +;WHEN LOADING, LIST SNAMES AS ENCOUNTERED +LDMUT4: MOVE A,HSNM + CAMN A,CUSN + POPJ P, ;SAME NAME + PUSHJ P,TAPN + MOVEM A,CUSN ;NEW NAME + PSIS CUSN + JRST CRR + +;LIST A FILE THAT'S ACTUALLY BEING LOADED +LDMUT3: PUSHJ P,TAPN + PSIS HFN1 + PSIS HFN2 + SKIPE LNKFLG + PUSHJ P,LDMUT5 + SKIPN LNKFLG + PDPT HPKN + JRST CRR + SUBTTL RETRIEVAL ROUTINES (LOAD, RELOAD) + +RETRV0: SKIPL LDPACK + SKIPE LOSRSW + JRST RETRV + PRINT LDPACK FEATURE ISN'T GOING TO WORK UNLESS YOU RELOAD IN SORRY MODE + JRST ERR + +SFRETR: PUSHJ P,FILSKP ;FLUSH CURRENT FILE, THEN DROP INTO RETRV + +;ENTER HERE FROM EXECU FOR LOAD AND RELOAD COMMANDS +RETRV: PUSHJ P,MAGOP ;OPEN TAPE + POPJ P, ;END OF TAPE + SKIPL A,LDPACK + JRST [ CAME A,HPKN ;ON SINGLE PACK BEING RELOADED? + JRST SFRETR ;NO, SKIP IT + JRST .+1 ] + SKIPL A,BBPACK + JRST [ CAME A,HPKN ;ON SINGLE PACK BEING BROUGHT BACK? + JRST SFRETR ;NO, SKIP IT. + JRST .+1 ] + SKIPE LSTWHL ;LIST? + PUSHJ P,LDMUT4 + MOVN W,LENGTH ;SEE IF THIS IS ONE OF THE FILES + HRLZS W ;THAT WE WERE ASKED TO LOAD. +COMCN2: SKIPN D,FMSNM(W) + JRST CM2FN1 + CAME D,HSNM + JRST NEXCM2 +CM2FN1: SKIPN D,FMFN1(W) + JRST CM2FN2 + CAME D,HFN1 + JRST NEXCM2 +CM2FN2: SKIPE D,FMFN2(W) + CAMN D,HFN2 + JRST RETRVF +NEXCM2: AOBJN W,COMCN2 + JRST SFRETR ;IT'S NOT, FLUSH IT + +;CURRENT TAPE FILE MATCHES SPECS OF FILES TO BE LOADED +RETRVF: IRP X,,[FN1,FN2] ;STORE FILE NAMES INTO 'CPYO' OPEN BLOCK + SKIPE A,TO!X(W) + MOVEM A,L!X + MOVE A,H!X + SKIPN TO!X(W) + MOVEM A,L!X +TERMIN + MOVEI A,(SIXBIT /DSK/) + SKIPN TODEV(W) + HRRM A,CPYO ;UNSPECIFIED DESTINATION FOR LOADS IS DISK + SKIPE A,TODEV(W) + HLRM A,CPYO ;SPECIFIED DESTINATION + SKIPN A,TOSNM(W) + MOVE A,HSNM ;UNSPECIFIED SNAME IS THE ONE READ FROM TAPE + .SUSET [.SSNAM,,A] ;SET SNAME FOR MERGE TEST + MOVEI B,36 ;BLOCK IMAGE INPUT, DON'T TOUCH REFDATE, + HRLM B,CPYO ; AND DON'T CHASE LINKS + SKIPGE DEADPK ;If DEADPK being restored + JRST CHMRG + MOVE B,LFN1 ; SNAME still in A... + MOVE C,LFN2 + PUSHJ P,DKLOOK ; Look up file on disk + JRST SFRETR ; No longer around, skip it + MOVEM A,DKBLK ; Save this for later... + MOVE B,UNRNDM(A) + LDB C,[UNPKN B] + TLNN B,UNLINK + CAME C,DEADPK + JRST SFRETR ; Link, or wrong pack, skip it + MOVEI D,[ASCIZ\file on tape is a link.\] + SKIPE LNKFLG + JRST NORETR ; What kind of a tape is he using? + MOVE B,UNDATE(A) + CAMN B,HDATE + JRST OKRETR ; Dates match, go read it! + MOVEI D,[ASCIZ\file on disk has a different creation date.\] + JRST NORETR + +;CHECK FOR MERGE MODE +CHMRG: SKIPL MRGSW + JRST CHCARE + .OPEN DSKOUT,CPYO ;MERGE. DON'T LOAD IF FILE EXISTS. + JRST OKRETR ;FILE DOESNT EXIST + MOVEI D,[ASCIZ\file already exists on disk.\] + JRST NORETR ;FILE EXISTS, DON'T FILE ON TOP OF. + +;IF NOT IN MERGE MODE, SEE IF FILE EXISTS ON DISK AND +; ISN'T DUMPED YET AND WE'RE BEING CAREFUL. IF SO, DON'T CLOBBER IT. +CHCARE: SKIPE CAREF + SKIPE MICFLG + JRST CHRECN ;IF NOT BEING CAREFUL, LOAD OVER + .OPEN DSKOUT,CPYO + JRST OKRETR ;IF DOESNT EXIST, LOAD OVER + MOVEI A,DSKOUT + .DMPCH A, ;OTHERWISE, SEE IF DUMPED + JUMPN A,CHRECN ;YES WAS DUMPED, OK TO LOAD OVER + MOVEI D,[ASCIZ\file exists on disk and has not been backed up.\] + JRST NORETR + +;CHECK FOR OVER-WRITING MORE RECENT FILE +CHRECN: SKIPE LOSRSW + JRST OKRETR ;DON'T CHECK IF SORRY MODE + MOVEI A,36 ;BLOCK IMAGE INPUT, DON'T SET REF DATE, + HRLM A,CPYO ; AND DON'T CHASE LINKS + .OPEN DSKOUT,CPYO + JRST OKRETR ;FILE DOES NOT EXIST, NO OVERWRITE PROBLEMS + .CALL [ SETZ ? 'FILBLK ? MOVEI DSKOUT ;GET FILE INFO + MOVEM D ? MOVEM D ? MOVEM D ;D GETS UNRNDM BITS + SETZM A ] ;A GETS CREATION DATE + .LOSE %LSFIL + TLNN D,UNLINK ;DON'T WORRY ABOUT LINKS, OR FILES + CAMG A,HDATE ;WITH OLDER CREATION DATE THAN THAT ON TAPE + JRST OKRETR + MOVEI D,[ASCIZ\a newer file with same name exists on disk.\] + JRST NORETR + +;FILE SPECS SAY TO RETRIEVE THIS FILE, BUT OTHER OPTIONS SUCH +;AS MERGE SAY NOT TO. D -> ASCIZ STRING FOR WHY THIS SHOULDN'T +;BE RETRIEVED. IF 'NOASK' WAS NOT SPECIFIED, CONSULT +;USER, OTHERWISE SKIP IT. +;W -> CURRENT RETRIEVAL FILE, CPYO (LFN1, LFN2) HAS ACTUAL FILE WRITING TO. +NORETR: SKIPE NOASK + JRST SFRETR ;YES, JUST FLUSH IT QUIETLY + PUSH P,LPTSW + SETZM LPTSW + PRINT _File + .SUSET [.RSNAME,,A] + PSIS A + PRINT [;] + PSIS LFN1 + PSIS LFN2 + PRINT [ not getting retrieved because ] + PASC (D) + PRINT [_Do you want to retrieve it anyway? ] +NORET1: PUSHJ P,TYI + MOVE D,A + PUSHJ P,CRR + CAIE D,"N + CAIN D,"Y + JRST NORET2 + PRINT [(Y or N) ] + JRST NORET1 + +NORET2: POP P,LPTSW + CAIE D,"Y + JRST SFRETR ;NO, FLUSH IT + JRST OKRETR ;YES, LOAD IT + +;SKIP AN INPUT FILE +FILSKP: SKIPGE TAPTYP + JRST [ SETOM CTRLG + PUSHJ P,RTAPE"SKPFIL + JRST CTRLGX ] + PUSH P,A + PUSH P,B + MOVEI A,7 + MOVE B,[MAGIN,,A] + .MTAPE B, ; SKIP TO EOF + JFCL + .CLOSE MAGIN, + POP P,B + POP P,A + POPJ P, + +;OK, WE'VE DECIDED TO RELOAD IT. +OKRETR: SKIPE LNKFLG + JRST RETRLK ;GO RELOAD LINK + MOVE A,HSNM ;DIR LOADING ONTO + CAMN A,[SIXBIT/.KLFE./] + JRST [ PRINT [ATTEMPT TO CLOBBER KL10 FRONT END DIRECTORY, FILE BEING SKIPPED_] + JRST SFRETR ] + MOVE B,HFN1 + CAMN A,[SIXBIT /./] + CAME B,[SIXBIT /.FEFS./] + SKIPA + JRST [ PRINT [ATTEMPT TO CLOBBER KS10 FRONT END FILESYSTEM, FILE BEING SKIPPED_] + JRST SFRETR ] + SKIPE A,TODEV(W) ;GET DEVICE TO WRITE TO + JRST OKRET0 ;EXPLICITLY SPECIFIED USE IT, OTHERWISE CHOOSE + MOVE B,HPKN ;IF RELOADING, AND FILE WAS FROM SECONDARY + MOVSI A,-NQS ; DISK, PUT IT BACK THERE + CAME B,QPKID(A) + AOBJN A,.-1 + JUMPGE A,OKRET9 + SKIPE A,QRESRV(A) + CAMN A,[-1] + JRST OKRET9 + SKIPL RELOSW +OKRET9: MOVSI A,'DSK +OKRET0: SKIPE CRDIR + .OPEN CRUFD ;CREATE DIRECTORY IF NON-EXISTENT + JFCL + .CALL [SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT] + A ? [SIXBIT/_DUMP_/] ? SETZ [SIXBIT/OUTPUT/]] + .LOSE 1400 ;MIGHT AS WELL LET DDT HANDLE IT + SKIPE LSTWHL + PUSHJ P,LDMUT3 ;LIST THIS FILE + SETZM HFNL + HLRZ A,HSNM + CAIN A,'LCF + PUSHJ P,ISLCF + MOVE A,HDATE + SKIPGE RELOSW ;IF NOT RELOADING, + JRST OKRET1 + SKIPE A + CAMN A,[-1] + PUSHJ P,ALD5 ;MAKE CREATION DATE FROM TAPE DATE +OKRET1: MOVEM A,FDATE + .CALL SDATE + JFCL ;IT DOESN'T MATTER WEATHER YOU WIN OR LOSE, ITS HOW YOU PLAY THE GAME. +OKRET2: MOVE A,[-2000,,BUF] + PUSHJ P,MAGRDL ;READ A BUFFER LOAD FULL + JRST RETRFN ;ERROR + HRLOI B,-BUF-1(A) + EQVI B,BUF + SKIPE HFNL + PUSHJ P,HFNLX + SKIPGE B + .IOT DSKOUT,B ;OUTPUT IT TO DISK + JUMPGE A,OKRET2 ;JUMP UNLESS EOF + PUSHJ P,FILSKP ;EOF, BE SURE. + SKIPN THTYPE + JRST OKRET3 ;RANDOM TAPE, DON'T CLEAR NOT-DUMPED INDIC. + .CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZI 1] + .LOSE 1000 +OKRET3: SKIPGE RELOSW + PUSHJ P,RELOAF ;IF WE ARE RELOADING, SET DUMPBIT,REAPBIT ,AUTHOR, REF DATE + SKIPL DEADPK + PUSHJ P,DKBLKF ; Restore attributes from saved file block + .CALL [SETZ ? 'RENMWO ? MOVEI DSKOUT ? LFN1 ? SETZ LFN2] + .LOSE 1000 +;FILE HAS BEEN LOADED, REMOVED FROM LOAD SPECS +RETRFN: .CLOSE DSKOUT, + SKIPE FMSNM(W) + SKIPN FMFN1(W) + JRST RETRV ;WAS "*"=> DON'T FLUSH ENTRY + SKIPN FMFN2(W) + JRST RETRV + PUSHJ P,FLUSH + POPJ P, ;NOTHING MORE TO DO + JRST RETRV + +ISLCF: HLRZ A,HFN1 + CAIE A,'ACT + CAIN A,'DUN + SETOM HFNL + POPJ P, + +HFNLX: PUSH P,B ;DONT COMPROMISE, RANDOMIZE! + PUSH P,A +HFNLXL: MOVE A,(B) + TSC A,1(B) + MOVEM A,(B) + AOBJN B,HFNLXL + POP P,A + POP P,B + POPJ P, + +;FLUSH ENTRY OF FILE THAT WAS JUST DUMPED, OR LOADED +;SKIP RETURN IF ANY MORE FILES TO BE DONE +FLUSH: SOSN B,LENGTH + POPJ P, ;NOTHING MORE TO DO + SUBI B,1 + HRLI A,FMDUMP+1(W) ;BLT DOWN ENTRIES ABOVE IT + HRRI A,FMDUMP(W) + BLT A,FMDUMP(B) + IRP X,,[FM,TO] + IRP Y,,[DEV,SNM,FN1,FN2] + HRLI A,!X!!Y+1(W) + HRRI A,!X!!Y(W) + BLT A,!X!!Y(B) + TERMIN + TERMIN + JRST POPJ1 + +; Restoring dead pack: set author, reference date, and reap bit from disk +; copy of UFD. +DKBLKF: MOVE C,DKBLK + LDB A,[UNAUTH UNREF(C)] + PUSHJ P,DKAUTH + .CALL [ SETZ ? SIXBIT /SAUTH/ ? MOVEI DSKOUT ? SETZ A ] + JFCL + HLLZ A,UNREF(C) + .CALL [ SETZ ? SIXBIT /SRDATE/ ? MOVEI DSKOUT ? SETZ A ] + JFCL + MOVE A,UNRNDM(C) + TLNE A,UNREAP + .CALL [ SETZ ? SIXBIT /SREAPB/ ? MOVEI DSKOUT ? SETZI 1 ] + JFCL + POPJ P, + +;RELOADING, SET MISCELLANEOUS FILE ATTRIBUTES FROM TAPE COPY OF UFD +RELOAF: SKIPGE UFDDAT + POPJ P, ;NO UFD IN CORE + MOVE A,HSNM + CAME A,UFDBUF+UDNAME + POPJ P, ;WRONG NAME + MOVE C,UDNAMP+UFDBUF + ADDI C,UFDBUF + MOVE A,HFN1 + SKIPA B,HFN2 +RELOF1: ADDI C,LUNBLK + CAIL C,UFDBUF+2000 + POPJ P, ;NOT FOUND + CAMN A,UNFN1(C) + CAME B,UNFN2(C) + JRST RELOF1 + MOVE A,HDATE + CAME A,UNDATE(C) + POPJ P, ;SAME NAMES, DIFFERENT CREATION DATE +RELOF2: LDB A,[.BP (UNREAP),UNRNDM(C)] + .CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A] + JFCL + LDB A,[.BP (UNDUMP),UNRNDM(C)] + .CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A] + JFCL + HLLZ A,UNREF(C) + .CALL [SETZ ? 'SRDATE ? 1000,,DSKOUT ? SETZ A] + JFCL + LDB A,[UNAUTH+UNREF(C)] + PUSHJ P,GEAUTH + POPJ P, + .CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A] + JFCL + POPJ P, + +;MAKE A A CREATION DATE FROM TAPE DATE +ALD5: SETZM A + PUSH P,B + PUSH P,C + LDB B,[300400,,THDATE] + LDB C,[360400,,THDATE] + IMULI C,10. + ADD B,C + DPB B,[330700,,A] + LDB B,[140400,,THDATE] + LDB C,[220400,,THDATE] + IMULI C,10. + ADD B,C + DPB B,[270400,,A] + LDB B,[000400,,THDATE] + LDB C,[060400,,THDATE] + IMULI C,10. + ADD B,C + DPB B,[220500,,A] + POP P,C + POP P,B + POPJ P, + +;RELOAD A LINK +RETRLK: SKIPE LSTWHL + PUSHJ P,LDMUT3 + MOVE A,LFN1 + MOVEM A,LNKBLK+1 + MOVE A,LFN2 + MOVEM A,LNKBLK+2 + .OPEN DSKOUT,LNKBLK + .LOSE 1400 ;SHOULD SUCCEED, LET DDT HANDLE IT. + PUSHJ P,FILSKP ;FLUSH TO EOF + SKIPL RELOSW ;IF RELOADING, + JRST RETRFN ; WILL HAVE TO RESTORE MISC CRUFT + MOVEI A,36 ;DON'T CHASE LINKS, DON'T SET REFD, + HRLM A,CPYO ; BLOCK IMAGE INPUT (REOPEN THE LINK) + .OPEN DSKOUT,CPYO + .LOSE 1400 ;WE JUST PUT IT THERE!! + PUSHJ P,RELOAF + JRST RETRFN + SUBTTL 'OPEN' A MAGTAPE FILE FOR INPUT + +; DFHBLK: Set all defaults in HBLK +; DFHDTS: Default dates in HBLK +DFHBLK: SETZM HBLK+1 + MOVE A,[HBLK+1,,HBLK+2] + BLT A,HBLK+LHBLK-1 + SETOM HLEN ; Unknown length +DFHDTS: SETOM HDATE ; Unknown creation date + HRROI A,777000 ; Unknown reference date + MOVEM A,HRDATE ; Unknown author, 36. bit bytes + POPJ P, + +MAGOT: PSIS CHNTAB+MAGIN ;LOST + PUSHJ P,OPINFL + PUSHJ P,CRR + MOVEI A,150. ;WAIT FOR SOMEONE TO FIX TAPE DRIVE + .SLEEP A, ;DROP THROUGH +;ENTER HERE, NON-SKIP IF EOT. +MAGOP: PUSHJ P,DFHBLK ; Set defaults in HBLK + SKIPGE TAPTYP ;SKIP IF USING LOCAL DRIVE + JRST MAGOP0 ;REMOTE DRIVE STAYS OPEN I GUESS + .OPEN MAGIN,MAGI ;OPEN MAG TAPE INPUT (READ HEADERS) + JRST MAGOT ;WAIT FOR HIM TO MOUNT TAPE OR REWIND +MAGOP0: CLEARM ERRCNT ;RESET ERR COUNT FOR THIS FILE + AOSE ITAPE ;SKIP IF BEGINNING OF TAPE + JRST ART2 ; ALSO INCREMENTS FILE SEQUENCE NUMBER + PUSH P,A + SKIPGE TAPTYP + PUSHJ P,RMTSTS ;DRAIN QUEUED STATUS + POP P,A + SETZM THTYPE + SETOM THDATE + HRROI A,B + PUSHJ P,MAGREAD ;READ AOBJN WORD INTO B + JRST MAGOP ;ERROR, TRY NEXT FILE + TRNE B,-1 + JSP D,BDHD ;BAD TAPE-HEADER - AOBJN WORD HAS NON-ZERO RIGHT HALF + CAMGE B,[-LTHBLK,,] + JSP D,BDHD ;BAD TAPE-HEADER - FIRST RECORD TOO LONG + ADD B,[1,,THBLK+1] + MOVE A,B + PUSHJ P,MAGREAD ;READ TAPE HEADER + JRST MAGOP ;ERROR, TRY NEXT FILE + HLRZ A,THTPN ;CHECK TAPE NUMBER + JUMPN A,ART3 ;IF NON-ZERO THEN IT IS VALID + PRINT [TAPE NUMBER ON TAPE IS 0, REAL TAPE NUMBER/NAME=] + PUSHJ P,GETSYL + JRST .-2 ;SOME SORT OF ERROR, REPROMPT + MOVEM SYM,NSVTPN + HRLM N,THTPN +ART3: PUSHJ P,PTHEAD ;TELL USER WHAT TAPE THIS CLAIMS TO BE +;HERE IF THIS WASN'T THE BEGINNING OF THE TAPE +ART2: HRROI A,B + PUSHJ P,MAGREAD ;READ ANOTHER WORD, SHOULD BE FILE HEADER AOBJN WD + JRST MAGOP + JUMPL A,EOTISH ;EOT + TRNE B,-1 + JSP D,BDHD ;BAD FILE-HEADER - AOBJN WORD NON-ZERO RIGHT HALF + CAMGE B,[-LHBLK,,] + JSP D,BDHD ;BAD FILE-HEADER - RECORD TOO LONG + CAMLE B,[-LHBLKZ,,] + JSP D,BDHD ;BAD FILE-HEADER - RECORD TOO SHORT + ADD B,[1,,HBLK+1] + MOVE A,B + PUSHJ P,MAGREAD ;READ USER NAME, FILE NAMES AND PACK NUMBER + JRST MAGOP + SKIPGE A + JSP D,BDHD1 ;BAD FILE-HEADER - NOT ALL THERE + SETZM LNKFLG + HLRZ B,HPKN + SKIPN B ;LINK? (BITS ON IN LH OF PACK NUMBER) + JRST MAGOP1 + MOVE A,[-3,,LNKNM1] ;YES, READ NAMES LINKED TO + PUSHJ P,MAGRDL + JRST MAGOP + SKIPGE A + JSP D,BDHD1 ;BAD FILE-HEADER - LINK NOT ALL THERE + SETOM LNKFLG + AOS (P) ;TAKE SUCCESS RETURN + POPJ P, + +EOTISH: PRINT E-O-T + SETOM EOTFLG + SKIPL TAPTYP ;SKIP IF REMOTE TAPE + .CLOSE MAGIN, + POPJ P, + +.SCALAR MGRDLF ; Flag for MAGRDL + +; Like MAGREAD, but respect length in HLEN. +MAGRDL: SKIPGE HLEN + JRST MAGREAD ; Length is implicit on old tapes + PUSH P,A + SETZM MGRDLF + PUSHJ P,MAGREAD + SETOM MGRDLF + EXCH B,(P) + MOVEI B,(B) + SUBI B,(A) ; B: minus # words read + ADDB B,HLEN ; Adjust HLEN + JUMPLE B,MAGRDJ ; HLEN exhausted + JUMPL A,MAGRDN ; EOF but HLEN promises more... +MAGRDX: POP P,B + SKIPN MGRDLF + AOS (P) + POPJ P, + +.VECTOR MGARB(LMGARB==:40) + +MAGRDJ: JUMPL A,MAGRDK ; Already at EOF? + PUSH P,A +MAGRDH: SKIPE MGRDLF ; Errors? + JRST MAGRDE ; Yes: Nothing to do + MOVE A,[-LMGARB,,MGARB] ; No: Read extra garbage + PUSHJ P,MAGREAD + SETOM MGRDLF + JUMPGE A,MAGRDH ; No EOF yet? Keep reading. +MAGRDE: POP P,A +MAGRDK: SETZM HLEN ; Nothing left + MOVN B,B ; Adjust caller's ptr + HRLI B,(B) + SUB A,B + JRST MAGRDX + +MAGRDN: SETOM MGRDLF + SETOM RDERR + SETOM ERRALL + AOS ERRCNT + PUSH P,LPTSW + SETZM LPTSW + PRINT _DATA ON TAPE TOO SHORT_ + PUSHJ P,TAPN + PSIS HSNM + PSIS HFN1 + PSIS HFN2 + PRINT LENGTH ERROR TAPE IN ..FILE BEING SKIPPED.._ + POP P,LPTSW + JRST MAGRDX + +;DO .IOT MAGIN,A AND SKIP IF NO DATA ERROR +;FILE MARK SIGNALLED BY NOT COUNTING OUT THE AOBJN POINTER +MAGREA: SETZM RDERR + SETZM PHYEOT + SKIPGE TAPTYP + JRST RMTREA + .IOT MAGIN,A + SKIPN RDERR + AOS (P) + POPJ P, + +RMTREA: PUSH P,B + CAMN A,[-1,,B] + HRROI A,(P) + TRNN A,-20 + DIE Program error--RMTREAD can't read into AC's + SETOM CTRLG + PUSHJ P,RTAPE"READ + JRST RMTRER ;Tape error + POP P,B + AOS (P) + JRST CTRLGX + +;Remote read error, code similar to INT1 and INT2 +RMTRER: PUSHJ P,CTRLGX + PUSH P,A + PUSH P,D + PUSH P,LPTSW ;Error messages on TTY + SETZM LPTSW + PRINT _TAPE READ ERROR_ + PUSHJ P,RTAPE"PRSTS + MOVE A,RTAPE"STSFLG ;Classify error + TRNE A,RTAPE"F%NLI+RTAPE"F%OFFL+RTAPE"F%EOT + JRST ERR ;Non-data error + AOS ERRCNT ;Non-recoverable data error + SETOM ERRALL + PUSHJ P,TAPN + PSIS HSNM + PSIS HFN1 + PSIS HFN2 + PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._ + TRNN A,RTAPE"F%EOF + PUSHJ P,FILSKP ;If not already at EOF, skip file + SETOM RDERR + POP P,LPTSW + POP P,D + POP P,B + POP P,A + POPJ P, + +;WRITE BLOCK (NOT RECORD) TO TAPE, AOBJN POINTER IN A +MAGWRI: SKIPGE TAPTYP + JRST [ SETOM CTRLG ;Remote drive + PUSHJ P,RTAPE"WRITE + JRST CTRLGX ] + .IOT MAGOUT,A ;Local drive + POPJ P, + +;Come here if write error on remote drive +;during RTAPE"WRITE, RTAPE"FORCE, or RTAPE"WRTFM +;Stack level unpredictable, but not at interrupt level +;All writes pass through ADMP4, which saves state so we can restore it +RMTWER: PUSHJ P,CTRLGX + PUSH P,LPTSW ;Error messages on TTY + SETZM LPTSW + MOVE A,RTAPE"STSFLG + TRNE A,RTAPE"F%EOT + JRST RMTEOT + PRINT _TAPE WRITE ERROR_ + PUSHJ P,RTAPE"PRSTS + PRINT _SIMULATING E-O-T .. +RMTEOT: MOVEI A,FOOB ;AH ! I KNOW HOW TO HANDLE END OF TAPE ! + SKIPGE FULLDMP + JRST INTX1 ;CAUSE PROGRAM TO RESTART AT FOOB + DIE _PHYSICAL END OF TAPE + +;BAD HEADER, SKIP FILE +BDHD: MOVE A,[-3,,HSNM] + PUSHJ P,MAGREAD + JRST MAGOP ;ERROR +BDHD1: PRINT _BAD HEADER + PSIS HSNM ;TRY TO TYPE STUFF PAST LOSING HEADER + PSIS HFN1 + PSIS HFN2 + PUSHJ P,CRR + PUSHJ P,FILSKP ;FLUSH CURRENT FILE + JRST MAGOP + +;MAGOP, NOT A LINK +MAGOP1: MOVE A,HFN1 + MOVE B,HFN2 + CAMN A,[SIXBIT /M.F.D./] + CAME B,[SIXBIT /(FILE)/] + SKIPA + JRST MAGOP2 ;READ IN COPY OF MFD + CAMN A,[SIXBIT /.FILE./] + CAME B,[SIXBIT /(DIR)/] + JRST POPJ1 ;AN ORDINARY FILE, TAKE SUCCESS RETURN +;READ IN UFD FROM TAPE + SETZM UFDBUF + MOVE A,[UFDBUF,,UFDBUF+1] + BLT A,UFDBUF+1777 + MOVE A,[-UDDESC,,UFDBUF] ;GET HEADER AREA + PUSHJ P,MAGRDL + JRST MAGOP ;ERROR, FLUSH + MOVE A,UFDBUF+UDESCP ;COMPUTE SIZE OF DESCRIPTOR AREA + ADDI A,5 + IDIVI A,6 + MOVNS A + HRLS A + HRRI A,UFDBUF+UDDESC + PUSHJ P,MAGRDL ;READ IN DESCRIPTOR AREA + JRST MAGOP ;ERROR, FLUSH + MOVE A,UDNAMP+UFDBUF ;COMPUTE SIZE OF NAME AREA + SUBI A,2000 + HRLS A + HRR A,UDNAMP+UFDBUF + ADDI A,UFDBUF + PUSHJ P,MAGRDL ;READ IN NAME AREA + JRST MAGOP ;ERROR, FLUSH + MOVE A,HDATE + MOVEM A,UFDDAT + SKIPGE RELOSW ;IF RELOADING, + PUSHJ P,MAGOP3 ; UPDATE DISK DIRECTORY FROM TAPE + SKIPGE PDIRSW + PUSHJ P,PTUFD ;PRINT UFD FROM TAPE + HRRZ A,(P) + CAIN A,RLDRD0+1 ;RELOAD RDATES FROM THIS DIR + PUSHJ P,RLDRD1 + PUSHJ P,FILSKP ;DONE WITH THIS FILE + JRST MAGOP ;TRY TO OPEN A REAL FILE + +PTUFD: PUSH P,C + PUSH P,B + PUSH P,A + PUSH P,W + PUSH P,N + MOVE C,UFDBUF+UDNAMP + ADDI C,UFDBUF +PTUFD1: CAIL C,UFDBUF+2000 + JRST [ POP P,N + POP P,W + POP P,A + POP P,B + POP P,C + POPJ P,] + SKIPE (C) + SKIPN 1(C) + JRST PTUFD2 + PUSHJ P,CRR + MOVE B,UNRNDM(C) + TLNE B,UNLINK + PASC [ASCIZ /L /] + PSIS (C) + PSIS 1(C) + TLNE B,UNLINK + JRST [ PASC [ASCIZ /=>/] + LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX + PUSH P,B+1 + IDIVI B,UFDBYT + ADDI B,UFDBUF+UDDESC + MOVNI N,-6(B+1) + IMULI N,6 + HRLI N,60200 ;ASSUMING B=2 !!! + ROT N,30. + POP P,B+1 + PUSHJ P,GETLSL + PSIS W ;SNAME + PASC [ASCIZ /;/] + PUSHJ P,GETLSL + PSIS W ;LINK FN1 + PUSHJ P,GETLSL + PSIS W + JRST .+1] +PTUFD2: ADDI C,LUNBLK + JRST PTUFD1 + + +;"RELOAD" A DIRECTORY IF IT MATCHES AGAINST THE FILE SPEC LIST +MAGOP3: MOVN A,LENGTH + HRLZS A +MAGOP4: SKIPE B,FMSNM(A) + CAMN B,HSNM + JRST DIRUPD + AOBJN A,MAGOP4 + POPJ P, + +;READ IN MFD FROM TAPE +MAGOP2: MOVE A,[-2000,,MFDBUF] + PUSHJ P,MAGRDL + JRST MAGOP ;ERROR, FLUSH + MOVE A,HDATE + MOVEM A,MFDDAT + PUSHJ P,FILSKP ;DONE WITH THIS FILE +;GO THROUGH ALL DIRECTORIES IN DISK MFD BUT NOT IN TAPE MFD. +;FOR EACH, SEE IF IT CONTAINS NO 'NEW' FILES. IF SO, OFFER +;TO DELETE IT. ONLY DO THIS WHEN RELOADING, OF COURSE. + SKIPL RELOSW + JRST MAGOP + .CALL [SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH] + [SIXBIT/DSK/] ? [SIXBIT/M.F.D./] ? SETZ [SIXBIT/(FILE)/]] + .LOSE 1400 + MOVE A,[-2000,,BUF] + .IOT UFDCH,A + .CLOSE UFDCH, + SKIPA E,BUF+MDNAMP ;POINTS AT DISK MFD +MFDUP3: ADDI E,LMNBLK + CAIL E,2000 + JRST MAGOP ;DONE ALL OF DISK MFD + SKIPN A,BUF(E) ;NAME OF A DISK DIR + JRST MFDUP3 + MOVE D,MFDBUF+MDNAMP ;POINTS AT TAPE MFD +MFDUP2: CAIL D,2000 + JRST MFDUP4 ;DIR EXISTS ON DISK BUT NOT ON TAPE + CAMN A,MFDBUF(D) + JRST MFDUP3 ;OK, DIR EXISTS ON BOTH + ADDI D,LMNBLK + JRST MFDUP2 + +MFDUP4: .SUSET [.SSNAME,,A] ;THIS DIR IS CANDIDATE FOR DELETION + MOVEI A,.BII + HRLM A,FNO + .OPEN UFDCH,FNO + .LOSE 1400 + MOVE A,[-2000,,BIF] + .IOT UFDCH,A + .CLOSE UFDCH, + MOVE B,BIF+UDNAMP + CAIL B,2000 + JRST MFDUP3 ;Directory already empty, ignore + CAIA +MFDUP5: ADDI B,LUNBLK + CAIL B,2000 + JRST MFDUP6 + MOVE C,UNDATE+BIF(B) + CAMLE C,MFDDAT + JRST MFDUP3 ;NEW FILE, PRESERVE THE DIR + HLLZ C,UNREF+BIF(B) + CAMLE C,MFDDAT + JRST MFDUP3 ;OLD FILE, BUT NEWLY REFERENCED + JRST MFDUP5 + +MFDUP6: PUSH P,LPTSW + SETZM LPTSW + PRINT _Directory + PSIS BIF+UDNAME + PRINT [ exists on disk but not tape and contains only old files.] + PRINT [_Shall I delete it? ] + PUSHJ P,GETSYL + PUSHJ P,CRR + POP P,LPTSW + CAMN SYM,[SIXBIT/NO/] + JRST MFDUP3 + CAME SYM,[SIXBIT/YES/] + JRST MFDUP6 + SKIPA B,BIF+UDNAMP +MFDUP7: ADDI B,LUNBLK + CAIL B,2000 + JRST MFDUP3 + .CALL [SETZ ? 'DELETE ? [SIXBIT/DSK/] + BIF+UNFN1(B) ? SETZ BIF+UNFN2(B)] + .LOSE 1400 + JRST MFDUP7 + SUBTTL UPDATE DISK DIRECTORY FROM TAPE (RELOAD) + +DIRUPD: .SUSET [.SSNAM,,UFDBUF+UDNAME] + MOVEI A,.BII + HRLM A,FNO + .OPEN UFDCH,FNO + CAIA + JRST DIRU0 + .SUSET [.RIOS+UFDCH,,A] ;DIR SEEMS NOT TO EXIST + LDB A,[220600,,A] + CAIE A,20 ;NO SUCH DIRECTORY ERROR CODE + .LOSE ;HMM, NEED HUMAN ASSISTANCE + SKIPE CRDIR + JRST DIRUCR + PUSH P,LPTSW + SETZM LPTSW + PRINT _DIRECTORY + PSIS UFDBUF+UDNAME + PRINT [ DOES NOT EXIST ON DISK, SHALL I CREATE IT? ] + PUSHJ P,TYI + MOVE D,A + PUSHJ P,CRR + POP P,LPTSW + CAIE D,"Y + POPJ P, ;NOT CREATING IT, GIVE UP +DIRUCR: .OPEN UFDCH,CRUFD + JFCL ;SHOULD GET FNF + JRST DIRUPD ;NOW TRY AGAIN + +DIRU0: MOVE A,[-2000,,BIF] ;READ DISK COPY INTO COMPARE BUFFER + .IOT UFDCH,A + .CLOSE UFDCH, + MOVE B,BIF+UDNAMP + ADDI B,BIF ;B POINTS TO NAME AREA ON DISK COPY + MOVEI A,.BII+30 ;DON'T CHASE LINKS BIT, DON'T SET RDATE BIT. + HRLM A,TRNI ;DROPS THROUGH + +;HERE WE LOOP OVER ALL FILES ON DISK ON THIS DIRECTORY. FOR EACH ONE, +;IF IT IS NOT ON THE TAPE THEN (UNLESS IT IS NEW) WE DELETE IT. +;IF IT IS ON THE TAPE, AND THE TAPE COPY IS NEWER, WE DELETE THE +;DISK FILE TO TRY AND AVOID GETTING DEVICE/DIRECTORY FULL WHEN WE +;TRY AND LOAD IT LATER ON. IF IT SEEMS TO BE THE SAME VERSION +;ON TAPE AND ON DISK, WE UPDATE THE MISCELLANEOUS ATTRIBUTES. +;NOTE THAT THIS LOOP APPLIES TO LINKS AS WELL AS FILES. +DIRUPL: CAIL B,BIF+2000 + JRST DIRU5 ;PROCESSED WHOLE DIRECTORY + MOVE D,(B) + MOVE E,1(B) + MOVEM D,FN1 + MOVEM E,FN2 + MOVE A,UNDATE(B) + CAMLE A,UFDDAT ;DISK FILE NEWER THAN TAPE, LEAVE IT ALONE + JRST DIRUPN + HLLZ A,UNREF(B) + CAMLE A,UFDDAT ;OLD FILE, BUT RECENTLY REFERENCED, + JRST DIRU8 ; SO LEAVE IT ALONE + MOVE C,UFDBUF+UDNAMP + ADDI C,UFDBUF ;C POINTS TO NAME AREA ON TAPE COPY +DIRU1: CAIL C,UFDBUF+2000 ;FIND TAPE COPY IF IT EXISTS + JRST DIRU4 + CAMN D,(C) + CAME E,1(C) + JRST DIRU2 + SKIPL LDPACK ;DON'T MESS OVER NOW, IF WILL BE RELOADING + JRST DIRU8 ;TAPE COPY IN SORRY MODE ANYWAY. + MOVE A,UNDATE(B) + CAME A,UNDATE(C) + JRST DIRU4A ;SAME NAMES, DIFFERENT CREATION DATE, DELETE IT + JRST DIRU3 + +DIRU2: ADDI C,LUNBLK + JRST DIRU1 + +;FILE DOES NOT EXIST ON TAPE, OR WILL BE LOADED OVER. +;DELETE IT EITHER BECAUSE BEING FLUSHED OR TO MAKE ENOUGH ROOM +;ON DISK AND IN DIR TO ALLOW IT TO BE RELOADED. +DIRU4: SKIPN LSTWHL + JRST DIRU4A + PRINT [DELETE] ;MAKE LISTING LINE FOR FILE REALLY BEING + PSIS UFDBUF+UDNAME ;DELETED (I.E. NOT JUST BEING LOADED OVER) + PSIS FN1 + PSIS FN2 + PUSHJ P,CRR +DIRU4A: .FDELE TRNI ;DELETE IT FROM DISK + JFCL + JRST DIRU8 + +;SAME NAMES, SAME CREATION DATE. RESTORE OTHER CRUFT. +;WORKS EVEN FOR LINKS SINCE DON'T CHASE LINKS BITS IS SET +DIRU3: SETO E, ;FLAG NOT OPENED YET + HLLZ A,UNREF(B) + HLLZ D,UNREF(C) + CAME A,D + PUSHJ P,DIRURF ;UPDATE REF DATE + LDB A,[UNAUTH+UNREF(B)] + LDB D,[UNAUTH+UNREF(C)] + CAME A,D + PUSHJ P,DIRUAU ;UPDATE AUTHOR + LDB A,[430100,,UNRNDM(B)] + LDB D,[430100,,UNRNDM(C)] + CAME A,D + PUSHJ P,DIRUDB ;UPDATE REAPBIT + LDB A,[230100,,UNRNDM(B)] + LDB D,[230100,,UNRNDM(C)] + CAME A,D + PUSHJ P,DIRURB ;UPDATE REAP BIT + .CLOSE DSKIN, +DIRU8: ADDI B,LUNBLK + JRST DIRUPL + +;FOUND FILE ON DISK NEWER THAN TAPE. +DIRUPN: LDB A,[UNPKN+UNRNDM(B)] + CAME A,LDPACK + JRST DIRU8 ;LEAVE IT + LDB A,[UNLNKB+UNRNDM(B)] + JUMPN A,DIRU8 ;LINK IS OK + JRST DIRU4 ;REALLY GONE, DELETE IT + +;GET AUTHOR SIXBIT GIVEN MAGIC NUMBER IN DIRECTORY +GEAUTH: SKIPGE MFDDAT ;INDEX IN A, RETURN MFD ENTRY IN A + POPJ P, ;MFD NOT IN CORE, CAN'T LOOK IT UP + PUSH P,B + MOVE B,MDNUDS+MFDBUF + SUB A,B + LSH A,1 + MOVE A,MFDBUF+2000(A) + POP P,B + AOS (P) + POPJ P, + +;FILE NOT ALREADY OPEN, OPEN SO CAN UPDATE STUFF +DIROPF: OPEN DSKIN,TRNI + JRST POP1J + POPJ P, + +POP1J: SUB P,[1,,1] + POPJ P, + +;UPDATE DUMPCHECK BIT +DIRUDB: AOSN E + PUSHJ P,DIROPF + .CALL DIRSDB + JFCL + POPJ P, + +DIRURB: AOSN E + PUSHJ P,DIROPF + .CALL DIRSRB + JFCL + POPJ P, + +DIRURF: AOSN E + PUSHJ P,DIROPF + .CALL DIRSRF + JFCL + POPJ P, + +DIRUAU: MOVE A,D + PUSHJ P,GEAUTH + POPJ P, + AOSN E + PUSHJ P,DIROPF + .CALL DIRSAU + JFCL + POPJ P, + +DIRSAU: SETZ + SIXBIT /SAUTH/ + 1000,,DSKIN + SETZ A + +DIRSDB: SETZ + SIXBIT /SDMPBT/ + 1000,,DSKIN + SETZ D + +DIRSRB: SETZ + SIXBIT /SREAPB/ + 1000,,DSKIN + SETZ D + +DIRSRF: SETZ + SIXBIT /SRDATE/ + 1000,,DSKIN + SETZ D + +;SCAN ALL FILES IN TAPE UFD AND MAKE ANY REQUIRED LINKS. +;THE REASON THIS HAS TO BE DONE IS THAT LINKS ARE NOT +;PUT ON INCREMENTAL DUMPS. +;NOTE THAT IF ANY FILE WITH THE SAME NAME EXISTS, DON'T MAKE +; THE LINK SINCE THE FILE WAS LESS WORTHY IT WOULD +; HAVE BEEN DELETED AT DIRU4. +DIRU5: MOVE C,UFDBUF+UDNAMP ;SCAN NAME AREA OF TAPE DIRECTORY + CAIL C,2000 + JRST DIRU7 ;EMPTY + ADDI C,UFDBUF +DIRU6: MOVE V,UNRNDM(C) + TLNE V,UNLINK + PUSHJ P,DIRMLK ;MAKE A LINK + ADDI C,LUNBLK + CAIGE C,UFDBUF+2000 + JRST DIRU6 +DIRU7: MOVEI A,.BII ;TURN OFF RANDOM BITS IN TRNI + HRLM A,TRNI + .CLOSE DSKOUT, + POPJ P, ;DIRUPD ALL DONE + +DIRMLK: MOVE W,UNFN1(C) + MOVEM W,LNKBLK+1 ;FIRST NAME + MOVEM W,FN1 + MOVE W,UNFN2(C) + MOVEM W,LNKBLK+2 + MOVEM W,FN2 + MOVEI A,30+.BII ;DON'T CHASE LINKS, DON'T SET REF DATE + HRLM A,TRNI + .OPEN DSKIN,TRNI ;SEE IF IT EXISTS (EVEN A LINK) + CAIA + POPJ P, ;YES, DON'T CLOBBER IT + LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX + PUSH P,B+1 + IDIVI B,UFDBYT + ADDI B,UFDBUF+UDDESC + MOVNI N,-6(B+1) + IMULI N,6 + HRLI N,60200 ;ASSUMING B=2 !!! + ROT N,30. + POP P,B+1 + PUSHJ P,GETLSL + SKIPN W + SETOM W ;IN CASE OF ZERO SNAME (?) + MOVEM W,LNKBLK+5 ; SNAME + PUSHJ P,GETLSL + MOVEM W,LNKBLK+3 ; LINK FN1 + PUSHJ P,GETLSL + MOVEM W,LNKBLK+4 + ;; POP P,B Good joke flushed by Alan 12/22/87 + .OPEN DSKOUT,LNKBLK ;MAKE THE LINK + .LOSE 1400 ;HMM, NOT SUPPOSED TO HAVE TROUBLE + .CALL [SETZ ? 'SFDATE ? MOVEI DSKOUT ? SETZ UNDATE(C)] + JFCL + JRST RELOF2 ;UPDATE MISC ATTRIBUTES + SUBTTL PRINT TAPE HEADER + +PTHEAD: PRINT TAPE NO + HLRZ A,THTPN + PDPT A + SKIPE A ;DON'T CONVERT IF TAPE NUMBER IS ZERO + MOVE C,[440600,,NSVTPN] + PUSHJ P,SIXNUM + PRINT CREATION DATE + PSIS THDATE + PUSHJ P,CRR + SKIPN THTYPE + POPJ P, + PRINT REEL NO + HRRZ B,THTPN + PDPT B + SKIPGE THTYPE + PRINT OF INCREMENTAL DUMP + SETZM NPLACE + PUSHJ P,SNPLAC + SKIPLE THTYPE + PRINT OF FULL DUMP + JRST CRR + +SIXNUM: IDIVI A,12 ;CREATES SIXBIT FILE NAME FROM CONTENTS OF A + PUSH P,B ;C INITIALLY SHOULD CONTAIN 440600,,LOC + CAIE A,0 + PUSHJ P,SIXNUM + POP P,A + ADDI A,20 + IDPB A,C + POPJ P, + SUBTTL CHECKING OF DUMP TAPES, SETTING HAS-BEEN-DUMPED BITS + +;ENTER HERE FROM END OF TAPE DURING AN INCREMENTAL DUMP +ICHECK: PUSHJ P,MAGOP + JRST ICKEOT + .SUSET [.SSNAM,,HSNM] + MOVE A,HSNM + CAMN A,LUSNM + JRST ICKEOT ;DON'T CHECK LAST USER (SO I DUMP CONTINUES ON NEXT TAPE WITH FULL USER) + MOVE A,HFN1 + MOVEM A,FN1 + MOVE A,HFN2 + MOVEM A,FN2 + MOVEI A,10+.BII ;DON'T SET RDATE BIT + HRLM A,TRNI + .OPEN DSKIN,TRNI + JRST ICK1 + .CALL RDATE + JFCL + MOVE A,FDATE + CAME A,HDATE + JRST ICK1 ;BEEN CHANGED SINCE + MOVE A,[ICKLP,,D] ;RUN LOOP IN ACS IF NOT KL10 + BLT A,D+ICKLPL-1 + SETZ A, + BLT A,0 + JUMPN A,ICK2 ;JUMP IF KL10 + HRRI TER,D ;CLOSE LOOP +ICK2: MOVE A,[-2000,,BUF] + .IOT DSKIN,A + PUSH P,A + MOVE A,[-2000,,BIF] + PUSHJ P,MAGRDL + JRST ICKER2 ;ERROR + MOVE B,A + POP P,A + SUBI B,BIF-BUF + CAME A,B + JRST ICKERR + CAMN A,[-2000,,BUF] + JRST ICK4 + PUSH P,A + HLLZ B,A + MOVE A,[-2000,,BUF] + SUB A,B + JRST (TER) ;TO CHECKING LOOP IN ACS OR CACHE + +ICK3: POP P,A + SKIPL A + JRST ICK2 ;GET ANOTHER BLOCK +ICK4: MOVE A,[400000,,DSKIN] + .DMPCH A, + MOVE A,HSNM + CAME A,[SIXBIT /VANISH/] + JRST ICK1 + .FDELE TRNI + JFCL +ICK1: .CLOSE DSKIN, + PUSHJ P,FILSKP + JRST ICHECK + +ICKLP: MOVE B,(A) ;D + MOVE C,BIF-BUF(A) ;E + CAME B,C ;N + JRST ICKER1 ;SYM + AOBJN A,ICKLP ;TER (RH MODIFIED TO D IF PUT INTO ACS) + JRST ICK3 ;U +ICKLPL==.-ICKLP + +ICKER1: POP P,A +ICKERR: JRST ICK1 + +ICKER2: POP P,A + .CLOSE DSKIN, + JRST ICHECK + +ICKEOT: POPJ P, + +;LCHECK COMMAND +ALCHEC: SETOM PNTALL + JRST ACHEK1 + +;ICHECK COMMAND +AICHEC: PUSHJ P,ICHECK + JRST RET + +;CHECK COMMAND +ACHECK: CLEARM PNTALL +ACHEK1: SETOM SUPERC ;SUPPRESS DATA ERROR COMMENTS + CLEARM MICFLG + SETOM CHKFLG + .CORE CORSIZ+1 + JRST .-1 + PUSHJ P,DEVGET ;CRUDE FILE CHECKER + CLEARM ALLWRD ;RESET TOTAL NUMBER OF WORDS FOR THIS REEL + SKIPN MICFLG + MOVEI A,(SIXBIT /DSK/) + HRRM A,TRNI +ACHUCK: PUSHJ P,MAGOP ;OPEN NEXT TAPE FILE + JRST ACHIND ;END-OF-TAPE + .SUSET [.SSNAME,,HSNM] + MOVE A,HFN1 + MOVEM A,FN1 + MOVE A,HFN2 + MOVEM A,FN2 + CLEARM WRDCNT + CLEARM LNTCNT + CLEARM WRDONG + CLEARM ERRALL + CLEARM ERRCNT ;RESET # OF TAPE IOCS + CLEARM ERRDSK ;RESET # OF DISK IOCS + SKIPE LNKFLG + JRST ACHUF3 + MOVEI A,10+.BII ;DON'T SET RDATE BIT + HRLM A,TRNI + .OPEN DSKIN,TRNI + JRST DSKOPL + SETOM NEWCHR + SKIPE MICFLG + JRST ACHUF1 + MOVEI A,DSKIN + .DMPCH A, + MOVEM A,NEWCHR + +ACHUF1: MOVE A,[-2000,,BUF] + .IOT DSKIN,A + HRLOI B,-BUF-1(A) + EQVI B,BUF ;AOBJN POINTER 1 + SKIPGE A + .CLOSE DSKIN, + PUSH P,A + MOVE A,[-2000,,BIF] + PUSHJ P,MAGRDL + JRST ACHUF4 + MOVE C,A + POP P,A + HRLOI D,-BIF-1(C) + EQVI D,BIF ;AOBJN POINTER 2 + SKIPL A + SKIPGE C + PUSHJ P,FILSKP + PUSHJ P,COMPAR ;COMPARE THE TWO BUFFERS + HRRZI D,-BIF(C) + ADDM D,WRDCNT + SKIPL A + JUMPGE C,ACHUF1 ;MORE TO COME + JRST ACHUF2 + +;LOSSAGE +ACHUF2: SKIPN PNTALL + SKIPE ERRALL + SKIPA + JRST CHKT5 + PUSHJ P,LOUSZ +CHKT6: PDPT WRDCNT + PRINT WORD + SOSE WRDCNT + PRINT S + SKIPN WRDCNT + PRINT +CHKT5: SKIPN WRDONG + JRST CHKT4 + PDPT WRDONG + PRINT BAD WORD + SOSE WRDONG + PRINT S + SKIPN WRDONG + PRINT + PRINT AT + PDPT SAVAOB + .CLOSE DSKIN, +CHKT4: MOVE A,WRDCNT + ADDM A,ALLWRD + SKIPN V,LNTCNT + JRST CHKT7 + MOVM W,V + PDPT W + SKIPL V + PRINT LONGER + SKIPG V + PRINT SHORTER + PRINT ON DISK +CHKT7: SKIPN ERRCNT + JRST CHKTA + PDPT ERRCNT + PRINT *TAPE IOC + SOSE ERRCNT + PRINT S + SKIPN ERRCNT + PRINT + PRINT * +CHKTA: SKIPN ERRDSK + JRST CHKTB + PDPT ERRDSK + PRINT *DISK IOC + SOSE ERRDSK + PRINT S + SKIPN ERRDSK + PRINT + PRINT * +CHKTB: SKIPN PNTALL + SKIPE ERRALL + PRINT ! + JRST ACHUCK + +ACHUF3: PUSHJ P,FILSKP + JRST ACHUF2 + +ACHUF4: POP P,A + JRST ACHUF2 + +LOUSZ: PUSHJ P,LOUSY + JFCL + SKIPE MICFLG + POPJ P, + SKIPN NEWCHR + PRINT NEW + SKIPE NEWCHR + PRINT + POPJ P, + +DSKOPL: PUSHJ P,LOUSY + JFCL + PUSHJ P,OPINFL + SETOM ERRALL + PUSHJ P,CHKT3 ;FLUSH TAPE FILE + JRST CHKT6 + +CHKT3: PUSH P,A + MOVE A,[-2000,,BIF] + PUSHJ P,MAGRDL + JRST POPAJ + MOVE C,A + POP P,A + HRRZI D,-BIF(C) + ADDM D,WRDCNT + JUMPGE C,CHKT3 + PUSHJ P,FILSKP + POPJ P, + +ACHIND: .CORE CORSIZ + JRST .-1 + .CLOSE DSKIN, + .CLOSE MAGIN, + PRINT _ REEL = + HRRZ A,THTPN + PDPT A + PRINT HAS + PDPT ALLWRD + PRINT WORDS__ + POPJ P, + +COMPAR: MOVE U,B + MOVE V,D + MOVE W,U + XOR W,V + TLNE W,-1 + JRST DSKUNC +COMPA0: JUMPGE U,CPOPJ + JUMPGE V,CPOPJ +COMPA1: MOVE W,(U) + CAME W,(V) + JRST WRNWRD +COMPA2: AOBJN U,.+2 + POPJ P, + AOBJN V,COMPA1 + POPJ P, + +WRNWRD: SKIPN WRDONG ;FIRST LOSSAGE ? + PUSHJ P,WRNWR1 + AOS WRDONG + JRST COMPA2 + +WRNWR1: HRRZ W,U + SUBI W,BUF + ADD W,WRDCNT + MOVEM W,SAVAOB + POPJ P, + +DSKUNC: HLRES U + HLRES V + SUB V,U + ADDM V,LNTCNT + SETOM ERRALL + MOVE U,B + MOVE V,D + JRST COMPA0 + +SUBTTL RESTORE REFERENCE DATES + +;START NORMALLY, THEN ^Z AND START AGAIN HERE +;DON'T TRY TO USE THIS DUMP JOB FOR ANYTHING ELSE! +RLDRDT: PRINT RESTORE REFERENCE DATES FROM TAPE WHEN CURRENT RDATE IS - + PUSHJ P,GETDAT + HLLZS DATE + MOVEI A,%DONRF+%DONLK+.UAI + HRLM A,TRNI +RLDRD0: PUSHJ P,MAGOP ;OPEN TAPE + JRST MLP ;END OF TAPE + PUSHJ P,FILSKP ;ADVANCE TO NEXT FILE + JRST RLDRD0 + +;CALLED BY MAGOP IF DIRECTORY SEEN +RLDRD1: .SUSET [.SSNAME,,UFDBUF+UDNAME] + PUSHJ P,CRR + PSIS UFDBUF+UDNAME + SKIPA U,UFDBUF+UDNAMP +RLDRD2: ADDI U,LUNBLK + CAILE U,1777-4 + POPJ P, ;END OF NAME AREA + MOVE A,UFDBUF+UNFN1(U) + MOVEM A,FN1 + MOVE A,UFDBUF+UNFN2(U) + MOVEM A,FN2 + OPEN DSKIN,TRNI ;OPEN DISK INPUT + JRST RLDRD2 ;FILE DOESN'T SEEM TO EXIST ANY MORE + .CALL RRDATE + .LOSE %LSFIL + HLLZ A,RFDATE + CAME A,DATE + JRST RLDRD3 + .CALL [ SETZ ? 'SRDATE ? MOVEI DSKIN ? SETZ UFDBUF+UNREF(U)] + .LOSE %LSFIL +RLDRD3: .CLOSE DSKIN, + JRST RLDRD2 + +SUBTTL LOCAL TO REMOTE TAPE COPY + +;START NORMALLY, GIVE REMOTE COMMAND, THEN ^Z AND START AGAIN HERE +TCOPY: MOVE A,TAPTYP + AOJL A,.+2 + DIE You must use the REMOTE command to specify tape server host first + PRINT _Mount input tape on local drive and blank output tape on remote drive. + SETZM DMPMOD + SETOM TCOPYF + SETOM OTAPE ;Start of output tape +TCOPY0: PRINT [_Type OK when ready. ] + PUSHJ P,GETSYL + JRST .-1 +TCOPY1: SETOM ITAPE ;Start of input tape + PUSHJ P,RMTSTS ;Make sure it's mounted (this also + TRNN A,TF%RDY ; drains queued status) + DIE OUTPUT TAPE NOT MOUNTED + PUSHJ P,SETIT4 ;Get status of local drive + TRNE A,TF%BOT + JRST TCOPY3 + PRINT [_Rewind input tape? ] + PUSHJ P,YESNO + JRST TCOPY3 + MOVEI A,1 + PUSHJ P,LCLOPR +TCOPY3: PUSHJ P,DFHBLK ; Set defaults in HBLK + ;; Start copying a file + SETOM EOFF + OPEN MAGIN,MAGI + JRST NAUGHT +TCOPY4: SETZM RDERR + SETZM PHYEOT + MOVE C,[-2000,,BUF] ;Copy next block of file + .IOT MAGIN,C + SKIPE RDERR + JRST TCOPY9 ;File cannot be read + PUSH P,C ;Save post-input aobjn pointer + MOVEI B,BUF ;Pointer to next header input + HRLOI A,-BUF-1(C) + EQVI A,BUF ;Aobjn pointer for output + AOSE EOFF ;See if first record in file + JRST TCOPY6 ;No, this is the middle of a file + CAMN C,[-2000,,BUF] + JRST TCOPY7 ;Logical end of tape + AOSE ITAPE ;See if first file on tape + JRST TCOPY5 + MOVE D,(B) ;First word on tape + TRNN D,-1 ;Skip if bad header + CAMGE D,[-LTHBLK,,] ;Skip if good header + JRST TCOPY5 + MOVSI C,1(B) ;Save tape header + HRRI C,THBLK+1 + BLT C,THBLK+LTHBLK-1 + HLRO C,D + MOVN C,C ;Number of words in tape header + ADDI B,(C) ;Advance over tape header + HRL C,C + AOSE OTAPE ;See if first file on output tape + ADD A,C ;No, skip over tape header on output +TCOPY5: MOVE D,(B) ;File header + TRNN D,-1 ;Skip if bad header + CAMGE D,[-LHBLK,,] ;Skip if good header + JRST TCOPY6 + CAMLE D,[-LHBLKZ,,] ;Skip if good header + JRST TCOPY6 + MOVSI B,1(B) ;Save file header for error messages + HRRI B,HBLK+1 + BLT B,HBLK+LHBLK-1 +TCOPY6: JUMPGE A,TCOP6A ;Jump if empty record + PUSHJ P,MAGWRI + AOS OTAPE ;Something has been written +TCOP6A: POP P,C ;Recover post-input aobjn pointer + JUMPGE C,TCOPY4 ;Jump unless EOF + PUSHJ P,AEOF ;Write EOF mark on tape + JRST TCOPY3 ;Copy next file + +;Physical end of tape reached +TCOP7A: AOSE EOFF ;See if first record in file + PUSHJ P,AEOF ;No, close off that partial file +TCOPY7: PRINT _End of tape._ + MOVEI A,2 ;Rewind and unload the input tape + PUSHJ P,LCLOPR + PRINT [Copy another tape onto same output tape? ] + PUSHJ P,YESNO + JRST TCOPY8 + PRINT _Mount next input tape on local drive. + JRST TCOPY0 + +TCOPY8: PUSHJ P,CLSOUT ;Write logical EOT + PUSHJ P,AUNLD ;Then unload the output tape + JRST TCOPY + +;File cannot be read -- system won't let us see the bad data either +TCOPY9: SKIPE PHYEOT + JRST TCOP7A + AOSE EOFF ;See if first record in file + JRST TCOP9A ;No + AOS ITAPE ;For file header that could not be read + AOSE OTAPE ;See if first file on output tape + JRST TCOPY3 ;No, don't copy this file at all + SETZM THTPN ;Write dummy header since real header + SETZM THDATE ;could not be read + SETZM THTYPE + MOVE A,[-LTHBLK,,THBLK] + PUSHJ P,MAGWRI + JRST TCOPY3 ;Don't copy file, just tape header + +TCOP9A: SETZM BUF ;Substitute one block of nulls for rest of file + MOVE A,[BUF,,BUF+1] + BLT A,BUF+1777 + MOVE A,[-2000,,BUF] + PUSHJ P,MAGWRI + PUSHJ P,AEOF ;Write EOF mark on tape + JRST TCOPY3 ;Copy next file + +;Skip if YES + PRINT [ Please type YES or NO: ] +YESNO: PUSHJ P,GETSYL + JRST YESNO-1 + CAMN SYM,[SIXBIT/YES/] + AOSA (P) + CAMN SYM,[SIXBIT/NO/] + POPJ P, + JRST YESNO-1 + SUBTTL REMOTE TAPE SUPPORT + +$$CHAOS==1 +$$HOSTNM==1 +$$SYMLOOK==1 +$$HSTMAP==1 +$$CONNECT==1 +.INSRT SYSENG;NETWRK > + +NETWRK"DEBUG: 0 ;NETWRK wants this for some reason + + .BEGIN RTAPE ;Remote Tape Package + +comment \ --- stuff remaining to do + +Problems convincing old server to disconnect from drive sometimes. +Attempts to create new server say drive is still busy (using HT). + +Unix (Hermes) appears to have a wonderful bug where if you write +a tape, rewind it, read a bunch, and then lose the network connection, +it writes two eof marks wherever the tape happened to be positioned. +Thanks a lot. + +Hermes drive tries really hard to screw you by setting the density +to 6250, even though I tell it in the mount command to use 1600. +When you mount the tape the drive's 1600 light is lit, but then +when you walk away it switches to 6250. Try making sure the +"sys sel" light is not on. + +VMS (Pygmalion) doesn't allow writing short records and also gives +an error status at logical end of tape. + +CORE DUMP MODE IN ITS SERVER DUE TO BLOCK SIZE PROBLEMS ?? +DUMP never seems to want to call CLOSE + +Should fix ILDB/IDPB loop in SIOKT to use KLH unaligned byte move +which I think can be found in SYSENG;FSCOPY +Perhaps this can be finessed by knowing what the alignment of the +system's buffers probably is and aligning my own buffer correspondingly. +Or just do my own packetizing, this will never run over TCP +The old code certainly spent essentially all its time at SIOKS3 +So I put in my own packetizing for output and the speed is slow but +no longer pitifull. I fixed my byte copying routine, the next +culprit is data reformatting in the Chaosnet interrupt routines. + +WRTFM should not need to force a packet out to the network, +but that's how my modularity is right now. +\ + +DEFINE PUSHAE AC,LIST +IRP LOC,,[LIST] +PUSH AC,LOC +TERMIN +TERMIN + +DEFINE POPAE AC,LIST +IRP LOC,,[LIST] +POP AC,LOC +TERMIN +TERMIN + +DEFINE PRTERR REASON + DIE [Remote-Tape protocol error--REASON] +TERMIN + +;Remote Tape Protocol Definitions + +;User to Server Opcodes + +RT%LGI==1 ;Login username password +RT%MNT==2 ;Mount direction reelid drive blocksize density norewind +RT%PRB==3 ;Probe uid (2 bytes) +RT%RD==4 ;Read n-records (ascii decimal); no arg means read continuous +RT%WRT==5 ;Record +RT%RWD==6 ;Rewind +RT%SYN==7 ;Rewind-sync +RT%UNL==8 ;Rewind-unload +RT%SPF==9 ;Space-file n-files (ascii decimal) +RT%SPR==10. ;Space-record n-records (ascii decimal) +RT%WFM==12. ;Write-file-mark +RT%CLS==13. ;Close + +;Server to User Opcodes + +RT%LGR==33. ;Login-response code message-string +RT%DTA==34. ;Read-data +RT%RFM==35. ;Read-file-mark +RT%STS==36. ;Status + +;Storage for decoded status, second word of each is byte length +STSVER: 1 ? 1 ;Protocol version number +STSUID: 0 ? 2 ;Probe unique ID, 0 if unsolicited +STSNRD: 0 ? 3 ;Number of records read +STSNSK: 0 ? 3 ;Number of objects skipped (?) +STSNWD: 0 ? 3 ;Number of writes discarded +STSLOP: 0 ? 1 ;Last non-probe opcode received +STSDEN: 0 ? 2 ;Density in bits per inch +STSRTR: 0 ? 2 ;Retries (?) +STSDRV: BLOCK 4 ;Asciz drive name +STSFLG: 0 ;Word of flag bits +F%SOL==1 ;Solicited flag +F%BOT==2 ;Beginning of tape +F%EOT==4 ;Past end of tape +F%EOF==10 ;EOF encountered in read +F%NLI==20 ;Not logged in error +F%MNT==40 ;Mounted +F%STRG==100 ;Explanatory string follows status +F%HER==200 ;Hard error encountered +F%SER==400 ;Soft error encountered +F%OFFL==1000 ;Offline +F%NREC==2000 ;Non-record-oriented device + +STATUS: BLOCK 20 ;Most recent explanatory string, asciz + +UIDG: 0 ;Unique ID generator + +RDAHD: 0 ;0 idle, 1 reading, -1 stopped with exception, + ; -2 stopped at file mark + +MXRECW==2000 ;Maximum record length in words +MXRECB==MXRECW*5 ;Maximum record length in bytes +BUFFER: BLOCK /4 ;Can hold biggest record (32-bit words) +BUFCNT: 0 ;Number of 32-bit words sitting in buffer +BUFPNT: 0 ;Number of words already taken out + +RESBUF: BLOCK 4 ;Residue of record (36-bit words) +RESBFC: 0 ;Number of 36-bit words in RESBUF +RESBFP: 0 ;Number of words already taken out + +MXSTSB==200 +STSBUF: BLOCK MXSTSB/4 ;Buffer for status records + +;Probe for status of remote drive +;Clobbers all registers, returns flags in D +PROBE: PUSHJ P,SPROBE ;Send probe command +PROBE7: PUSHJ P,LISTEN ;Read a response, waiting if necessary + PUSHJ P,PROBE0 + MOVE T,UIDG ;Verify that it isn't stale + CAME T,STSUID + JRST PROBE7 ;Try again + POPJ P, ;OK + +SPROBE: AOS D,UIDG ;Get a unique ID + DPB D,[341000,,STSBUF] ;Send it LSB first + LSH D,-8 + DPB D,[241000,,STSBUF] + MOVEI A,RT%PRB + MOVE B,[440800,,STSBUF] + MOVEI C,2 + JRST RSXMTF + +;Listen for status, read it and skip return if there is any +LISTEN: .CALL [ SETZ ? 'WHYINT ? MOVEI RSICH ? MOVEM T ? MOVEM T ? SETZM T ] + .LOSE %LSFIL + TLNN T,-1 ;Network input available? + POPJ P, ;No, exit + MOVE B,[440800,,STSBUF] + MOVEI C,MXSTSB + PUSHJ P,RSRCV ;Yes, read it into status buffer + CAIE A,RT%STS + JRST LISTEN ;Ignore any input other than Status + AOS (P) ;Skip return + JRST PROBE1 + +;Read a status record +PROBE0: MOVE B,[440800,,STSBUF] + MOVEI C,MXSTSB + PUSHJ P,RSRCV ;Should be status, response or unsolicited + CAIE A,RT%STS + JRST PROBE0 ;Something else, discard it +;Process a status record already received +PROBE1: MOVEI A,STSVER ;Read status into here +PROBE2: MOVE T,1(A) ;Number of bytes in this field + SETZB D,(A) ;Accumulate field here, least significant first +PROBE3: ILDB TT,B + LSH TT,(D) + ADDI D,8 + IORM TT,(A) + SOJG T,PROBE3 + ADDI A,2 + CAIE A,STSDRV + JRST PROBE2 + ILDB T,B ;Number of valid characters in drive name + MOVEI D,16. ;Number of allocated characters in drive name + HRLI A,440700 +PROBE4: ILDB TT,B + SOSGE T + MOVEI A,0 + IDPB TT,A + SOJG D,PROBE4 + IDPB D,A ;Ensure asciz termination + ILDB D,B ;First byte of flags + ILDB T,B ;Second byte of flags + LSH T,8 + IOR D,TT ;Leave flags in D for caller + MOVEM D,STSFLG + SUBI C,36. ;Number of bytes of status + SKIPGE C + PRTERR status record too short + TRNN D,F%STRG ;Explanatory string follows? + JRST PROBE6 + MOVE A,[440700,,STATUS] ;Yes, swallow it +PROBE5: ILDB T,B +PROB5A: CAME A,[100700,,STATUS+20] + IDPB T,A + CAIN T,215 + JRST [ MOVEI T,12 ? JRST PROB5A ] + SOJG C,PROBE5 + IDPB C,A +IFN 0,[ ;temporary code not needed any more I think + PUSH P,LPTSW + SETZM LPTSW + PRINT _REMOTE TAPE STATUS= + PASC STATUS + PRINT _ + POP P,LPTSW +];IFN 0 +PROBE6: MOVE A,STSVER + CAIE A,1 + PRTERR wrong protocol version number + POPJ P, ;Done reading status, flags in D + +;Print remote tape status most recently read +PRSTS: PUSH P,A + PRINT Remote tape status= + PASC STATUS + SKIPE STATUS + PUSHJ P,CRR + MOVE A,STSFLG + TRNE A,F%BOT + PRINT [BOT ] + TRNE A,F%EOT + PRINT [EOT ] + TRNE A,F%EOF + PRINT [EOF ] + TRNE A,F%NLI + PRINT [Not-logged-in ] + TRNN A,F%MNT + PRINT [Not-mounted ] + TRNE A,F%HER + PRINT [Hard-error ] + TRNE A,F%SER + PRINT [Soft-error ] + TRNE A,F%OFFL + PRINT [Offline ] + POP P,A + POPJ P, + +;Random tape operations, none wait for completion +UNLOAD: SKIPA A,[RT%UNL] +REWIND: MOVEI A,RT%RWD +RSXMT0: MOVEI C,0 + MOVE B,[440800,,BUFFER] ;SIOT checks bp even though count is 0 + JRST RSXMTF + +CLOSE: SKIPA A,[RT%CLS] +WRTFM: MOVEI A,RT%WFM ;write file mark + PUSHJ P,FORCE ;first force buffered output + JRST RSXMT0 + +SKPREC: SKIPA A,[RT%SPR] ;B has signed number of records/files to skip +SKPFL0: MOVEI A,RT%SPF + MOVE T,B + MOVE B,[440800,,BUFFER] + MOVEI C,0 + PUSHJ P,CMDN0 + MOVE B,[440800,,BUFFER] + PUSHJ P,RSXMTF + POPJ P, + +CMDN0: JUMPGE T,CMDN1 + MOVNS T + MOVEI TT,"- + IDPB TT,B + ADDI C,1 +CMDN1: IDIVI T,10. + PUSH P,TT + SKIPE T + PUSHJ P,CMDN1 + POP P,TT + ADDI TT,"0 + IDPB TT,B + AOJA C,CPOPJ + +;wait for completion of pending I/O +;skip return unless tape error +FINISH: PUSHAE P,[A,B,C,D,E] + PUSHJ P,PROBE ;By the time this answers, should be done + TRNN D,F%EOT+F%NLI+F%HER+F%OFFL ;Serious error? + AOS -5(P) ;No, take skip return + POPAE P,[E,D,C,B,A] + POPJ P, + +;Read data in core-dump mode into buffer addressed by aobjn pointer in A +;A is advanced +;Skip return unless tape error +;File mark signalled by not fully counting-out A +;Record boundaries are invisible at this level +READ: PUSHAE P,[B,C,D,E,T,TT] +READ0: SKIPN RESBFC ;Collect residue if any is present + JRST READ1 + AOS B,RESBFP + MOVE T,RESBUF-1(B) + MOVEM T,(A) + CAML B,RESBFC + SETZM RESBFC ;Residue exhausted + AOBJN A,READ0 + JRST READ8 ;No more data required + +READ1: SKIPN C,BUFCNT ;Have a buffered record? + JRST READ6 ;No, get one + SUB C,BUFPNT ;Number of words not yet read + IDIVI C,5 ;Number of 4-word blocks available + MOVE B,BUFPNT + HLRE T,A + MOVN T,T + LSH T,-2 ;Number of complete 4-word blocks wanted + CAMLE C,T + MOVE C,T ;Number of 4-word blocks to do + JUMPE C,READ2 ;Jump if no bulk conversion possible + PUSHJ P,RDCNV ;Copy data, advance A and B + JUMPGE A,READ8 ;Destination buffer exhausted + JRST READ1 ;Get more data + +READ2: PUSH P,A ;Fill residue buffer + MOVEI A,RESBUF + SETZM RESBFP + MOVE C,BUFCNT + SUB C,BUFPNT + LSH C,2 ;Number of bytes available + IDIVI C,5 ;Convert to words + CAILE C,4 ;At most 4 words residue + MOVEI C,4 + MOVEM C,RESBFC + MOVEI C,1 ;Translate one 4-word block + PUSHJ P,RDCNV + POP P,A + JRST READ0 ;Collect residue + +READ6: SKIPGE T,RDAHD ;Read-ahead stopped due to exception? + JRST [ AOJL T,READ8 ;EOF simply terminates the data + JRST READ9 ] ;Anything else takes failure return + PUSH P,A + JUMPG T,READ7 ;Jump if read-ahead already in progress + MOVEI A,RT%RD ;Initiate read-ahead + PUSHJ P,RSXMT0 + AOS RDAHD +READ7: SETZM BUFPNT + PUSHJ P,RSRCVB ;Receive next record from server + MOVE T,A ;Opcode of record received + POP P,A ;Recover aobjn pointer + CAIN T,RT%DTA + JRST [ ADDI C,3 + LSH C,-2 ;Number of words, rounded up + MOVEM C,BUFCNT ;Buffer now contains data + JRST READ1 ] + CAIN T,RT%STS + JRST [ SETZM RDAHD ;Read-ahead has terminated + PUSH P,A + PUSHJ P,PROBE1 ;Swallow the status record B points to + POP P,A + TRNE D,F%NLI+F%HER+F%OFFL ;Serious error? + SETOM RDAHD ;Yes, note exception has occurred + JRST READ6 ] ;Consider current status again + CAIE T,RT%RFM + PRTERR [record type other than data, read-file-mark, or status] + SETCMM RDAHD ;Filemark read, set RDAHD to -2 +READ8: AOS -6(P) ;Success return +READ9: POPAE P,[TT,T,E,D,C,B] + POPJ P, + +;Translate from 32-bit words to 36-bit words +;A - destination aobjn pointer +;B - source index in BUFFER +;C - number of 4-word blocks +;Arguments get advanced, T,TT are clobbered +RDCNV: DMOVE T,BUFFER(B) ;First two 32-bit words + LSH T,-4 ;Right-align first four bytes + LSH TT,4 ;Flush 4 bits out of fifth byte + LSHC T,4 ;First 36-bit word + MOVEM T,(A) + LSH TT,-12. ;Right-align bytes 6-8 + MOVE T,BUFFER+2(B) ;Third 32-bit word + ROTC T,8 ;TT has bytes 6-9 right-aligned + LSH T,4 ;Flush 4 bits out of 10th byte + ROTC T,4 ;Second 36-bit word in TT + MOVEM TT,1(A) + ROT T,16. ;Right align bytes 11-12 + MOVE TT,BUFFER+3(B) ;Fourth 32-bit word + LSHC T,16. ;T has bytes 11-14 right aligned + LSH TT,4 ;Flush 4 bits out of 15th byte + ROTC T,4 ;Third 36-bit word in T + MOVEM T,2(A) + LSHC T,8 ;Right align byte 16 + MOVE TT,BUFFER+4(B) ;Bytes 17-20 + ROTC T,-12. ;Right align bytes 17-19 in TT + LSH T,4 ;Flush 4 bits out of 20th byte + ROTC T,4 ;Fourth 36-bit word in TT + MOVEM TT,3(A) + ADD A,[4,,4] + ADDI B,5 + SOJG C,RDCNV + MOVEM B,BUFPNT + CAML B,BUFCNT + SETZM BUFCNT ;Source buffer exhausted + POPJ P, + +;Terminate read-ahead +;--- Doesn't try to count records/files read ahead +;--- Unclear who is supposed to call this in that case +STOP: SKIPLE RDAHD + PUSHJ P,PROBE ;This should stop it + SETZM RDAHD + POPJ P, + +;Skip rest of file, interacting properly with read-ahead +SKPFIL: PUSHAE P,[A,B,C,D,T,TT] + SKIPGE B,RDAHD + AOJL B,SKPFL9 ;Pass by file mark already read + JUMPLE B,SKPFL8 ;Send space-file command to drive +;Readahead in progress. Server may have already read up to file mark, +;but not past it. Send a probe so server shuts down, then swallow +;remaining readahead. + PUSHJ P,RDSTOP + JRST SKPFL9 ;File-mark seen +SKPFL8: MOVEI B,1 ;Space one file + PUSHJ P,SKPFL0 ;File mark not seen in readahead, so space-file +SKPFL9: SETZM RDAHD ;No matter what path we take, read-ahead is off + POPAE P,[TT,T,D,C,B,A] + POPJ P, + +RDRST: PUSHAE P,[A,B,C,D,T,TT] + SKIPLE RDAHD + PUSHJ P,RDSTOP + SETZM RDAHD + PUSHJ P,BUFRST + JRST SKPFL9 + +;Reset buffers +BUFRST: SETZM BUFCNT + SETZM RESBFC + POPJ P, + +;Send a probe so server shuts down, then swallow remaining readahead. +;Skip return unless file mark seen during swallowed readahead. +RDSTOP: PUSHJ P,SPROBE ;Tell server to stop + PUSHJ P,BUFRST ;Flush partially read input record + PUSH P,[0] ;Initialize file-mark-seen flag +RDSTP1: PUSHJ P,RSRCVB ;Receive next record from server + CAIN A,RT%DTA + JRST RDSTP1 ;Ignore data records + CAIN A,RT%RFM + JRST [ SETOM (P) ;File mark seen + JRST RDSTP1 ] + CAIE A,RT%STS + PRTERR [record type other than data, read-file-mark, or status] + PUSHJ P,PROBE1 ;Swallow status record + MOVE T,UIDG ;Verify that it isn't stale + CAME T,STSUID + JRST RDSTP1 ;Another status should be incoming + SKIPN (P) + AOS -1(P) ;No file-mark seen + SETZM RDAHD ;Read-ahead has been terminated + JRST POP1J + +;WRITE -- write core-dump mode data, AOBJN pointer in A +;Record boundaries are invisible at this level +;Aobjn pointer in A is advanced +;Clobbers no registers +;Abnormal exit: tape error jumps to RMTWER +WRITE: PUSHAE P,[B,C,D,E,T,TT] + SKIPN C,RESBFC ;If there is residue, append to it + JRST WRITE2 +WRITE1: MOVE T,(A) ;Copy into RESBUF until it is full or + MOVEM T,RESBUF(C) ; aobjn pointer counts out + AOS C,RESBFC + CAIGE C,4 + AOBJN A,WRITE1 + JUMPGE A,WRITE9 ;Did not fill up residue buffer + AOBJN A,.+1 ;Filled residue buffer, adjust aobjn pointer + PUSH P,A + MOVEI A,RESBUF ;Send off the residue + MOVEI C,1 + PUSHJ P,WRICNV + SETZM RESBFC + CAIL B,MXRECB/4 ;If buffer is now full, + PUSHJ P,FORCE1 ; send off that record + POP P,A ;Recover aobjn pointer +WRITE2: HLRE C,A ;Minus count of words remaining + MOVN C,C ;Positive count + TRZ C,3 ;Round down to multiple of 4 words + JUMPE C,WRITE7 ;Jump if only a residue remains + MOVE T,BUFCNT + IDIVI T,5 ;Number of 4-word blocks already in buffer + LSH T,2 + ADD T,C + CAILE T,MXRECW + SUBI C,-MXRECW(T) ;Whole transfer cannot be accomodated + HRL C,C ;Number of words to do in both halves + PUSH P,A ;Save and advance aobjn pointer + ADDM C,(P) + HRRZ C,C ;Compute number of 4-word blocks to do + LSH C,-2 + PUSHJ P,WRICNV ;Convert that much + CAIL B,MXRECB/4 ;If buffer is now full, + PUSHJ P,FORCE1 ; send off that record + POP P,A ;Recover aobjn pointer + JUMPL A,WRITE2 ;Jump if there is more to do +WRITE7: JUMPGE A,WRITE9 ;Not even a residue remains +WRITE8: MOVE T,(A) ;Copy residue into buffer + MOVEM T,RESBUF(C) + AOS C,RESBFC + AOBJN A,WRITE8 +WRITE9: POPAE P,[TT,T,E,D,C,B] + POPJ P, + + +;FORCE -- force buffered output, if any, as a short record +;Clobbers no registers +;Abnormal exit: tape error jumps to RMTWER +FORCE: PUSHAE P,[A,B,C,D,E,T,TT] + SKIPN BUFCNT + SKIPE RESBFC + PUSHJ P,FORCE1 + POPAE P,[TT,T,E,D,C,B,A] + POPJ P, + +FORCE1: PUSHJ P,LISTEN ;Any status incoming? + JRST FORCE2 ;No + TRNE D,F%EOT+F%NLI+F%HER+F%OFFL ;Serious error? + JRST RMTWER ;Yes, exit +FORCE2: MOVE C,BUFCNT + LSH C,2 ;Convert word count to byte count + SKIPN E,RESBFC + JRST FORCE3 ;Jump if no residue + PUSH P,C + MOVE A,[.BYTE 7 ? 3 ? 3 ? 3 ? 3 ? 3] + CAIGE E,2 ;Pad residue with ^Cs + MOVEM A,RESBUF+1 + CAIGE E,3 + MOVEM A,RESBUF+2 + CAIGE E,4 + MOVEM A,RESBUF+3 + MOVEI A,RESBUF ;Include the residue + MOVEI C,1 + PUSHJ P,WRICNV + POP P,C ;Residue doesn't count as 4 full words + IMULI E,5 ;5 bytes for each word of residue + ADD C,E + SETZM RESBFC +FORCE3: MOVEI A,RT%WRT + MOVE B,[440800,,BUFFER] +;If the tape server on PYG (VMS) worked, you would need +;this in order to be able to use it +IFN 0,[ + CAIGE C,16 ;God damn bag chomping VMS barfs if record + MOVEI C,16 ; is shorter than this +];IFN 0 + PUSHJ P,RSXMT ;Send off this record + SETZM BUFCNT + POPJ P, + + +;Convert from 36-bit form to 32-bit form +;A - address of 36-bit data +;C - number of 4-word blocks to do +;Returns new value of BUFCNT in C +;Bashes A,B,C,D,T,TT +WRICNV: MOVE B,BUFCNT ;Append 32-bit words to buffer +WRICN1: DMOVE T,(A) ;First two 36-bit words + MOVEM T,BUFFER(B) ;First 4 bytes + ROTC T,-8 ;5th byte to high end of TT + TLZ TT,600000 ;Book says these bits are zero + MOVEM TT,BUFFER+1(B) ;Second four bytes + EXCH T,TT + LSHC T,4 ;9th byte to low end of T + LSH TT,-4 ;10th byte to high end of TT + MOVE D,T ;Copy bits 30-31 of second 36-bit word + ANDI D,3 + ROT D,-4 + IOR TT,D + LSHC T,8 ;9th and 10 bytes in T + MOVE TT,2(A) ;Third 36-bit word + LSHC T,20. ;9th-12th bytes left-aligned in T + MOVEM T,BUFFER+2(B) + LSHC T,12. ;13th, 14th bytes to low end of T + LSH TT,-4 ;15th byte to high end of TT + MOVE D,T ;Copy bits 30-31 of third 36-bit word + ANDI D,3 + ROT D,-4 + IOR TT,D + LSHC T,8 ;13th-15th bytes in T + MOVE TT,3(A) ;Fourth 36-bit word + LSHC T,12. ;13th-16th bytes left-aligned in T + MOVEM T,BUFFER+3(B) + LSHC T,20. ;17th-19th bytes to low end of T + LSH TT,-4 ;20th byte to high end of TT + MOVE D,T ;Copy bits 30-31 of fourth 36-bit word + ANDI D,3 + ROT D,-4 + IOR TT,D + LSHC T,12. ;17th-20th bytes left-aligned in T + MOVEM T,BUFFER+4(B) + ADDI A,4 ;Advance to next block of words + ADDI B,5 + SOJG C,WRICN1 + MOVEM B,BUFCNT + POPJ P, + +;Open remote tape connection and mount tape +;A - asciz host name (0 to listen) +;B - address at which to map host table +;C - remote drive name in asciz +;D - direction in asciz (READ, WRITE, or BOTH) +;reel name assumed not to matter, I'll always use "ITS" as the reel ID +;Skip return if successful, otherwise tape is not mounted and status +;buffer contains the details. OZ sets F%HER but HT just returns a string. +OPEN: PUSH P,C + PUSH P,D + SETZM STSFLG + SETZM STATUS + MOVEI C,[ASCIZ/RTAPE/] + PUSHJ P,RSOPEN + JRST OPEN7 ;Failed +OPEN1: MOVE B,[440800,,BUFFER] ;Build mount command + MOVNI C,1 ;Remove final space by starting with -1 + MOVE A,(P) ;Direction + PUSHJ P,SOUT + MOVEI A,[ASCIZ/ITS/] ;Reel + PUSHJ P,SOUT + MOVE A,-1(P) ;Drive + PUSHJ P,SOUT + MOVEI A,RECLEN ;Maximum record length (decimal) + PUSHJ P,SOUT + MOVEI A,[ASCIZ/1600/] ;Density + PUSHJ P,SOUT + MOVEI A,[ASCIZ/NOREWIND/] ;Don't be gratuitous + PUSHJ P,SOUT + MOVEI A,RT%MNT ;Send mount command + MOVE B,[440800,,BUFFER] + PUSHJ P,RSXMTF + PUSHJ P,PROBE ;Did it work? + TRNE D,F%MNT + JRST POP2J1 ;Yes + TRNE D,F%NLI + JRST [ PUSHJ P,RMTLGN ;Login please + JRST OPEN1 ] ;And try again + JRST POP2J ;Failed + +OPEN7: MOVSI B,-17 ;Copy reason for failure into STATUS string +OPEN8: MOVE T,(A) + ADDI A,1 + MOVEM T,STATUS(B) + TRNE T,177_1 + AOBJN B,OPEN8 + JRST POP2J + +DEFINE FOO A + ASCIZ/A/ +TERMIN +RADIX 10. +RECLEN: FOO \MXRECB +RADIX 8 + EXPUNGE FOO + +;A - ASCIZ user name +;B - ASCIZ password +;Skip return if success, otherwise STATUS has the string +LOGIN: PUSHAE P,[A,B,C] + MOVE B,[440800,,BUFFER] ;Build login command + MOVNI C,1 ;Remove final space by starting with -1 + MOVE A,-2(P) ;User name + PUSHJ P,SOUT + MOVE A,-1(P) ;Password + SKIPE (A) + PUSHJ P,SOUT + MOVEI A,RT%LGI ;Send login command + MOVE B,[440800,,BUFFER] + PUSHJ P,RSXMTF + MOVE B,[440800,,STATUS] ;Receive response + MOVEI C,100 + PUSHJ P,RSRCV + CAIE A,RT%LGR + PRTERR wrong record type in response to login + JUMPE C,LOGIN9 ;Success return if count is zero + MOVE A,[440700,,STATUS] ;Convert 8 bit to asciz +LOGIN2: ILDB T,B + IDPB T,A + SOJG C,LOGIN2 + IDPB C,A + SOS -3(P) +LOGIN9: AOS -3(P) + POPAE P,[C,B,A] + POPJ P, + +POP2J1: AOS -2(P) +POP2J: SUB P,[2,,2] +CPOPJ: POPJ P, + +SOUT: TLNN A,-1 + HRLI A,440700 +SOUT1: ILDB T,A + JUMPE T,SOUT2 + IDPB T,B + AOJA C,SOUT1 + +SOUT2: MOVEI T,40 + IDPB T,B + AOJA C,CPOPJ + + +;Record-Stream support + +;Open a record stream to a Chaosnet host, and initialize it +;RSICH, RSOCH - input and output channels +;A - asciz host name (0 to listen) +;B - address at which to map host table +;C - asciz contact name +;Clobbers all ACs +;If successful, skip return +;If failure, A has asciz failure reason +RSOPEN: PUSH P,C + JUMPE A,RSOPN1 + PUSH P,A + LDB A,[121000,,B] ;Page number + MOVEI B,RSICH + PUSHJ P,NETWRK"HSTMAP ;--- Someday use DQ device instead? + JRST [ MOVEI A,[ASCIZ/Cannot map network host table/] + JRST POP2J ] + POP P,A ;Host name + PUSHJ P,NETWRK"HSTLOOK + JRST [ MOVEI A,[ASCIZ/Host not found in host table/] + JRST POP1J ] + PUSHJ P,NETWRK"HSTUNMAP + JFCL +RSOPN1: POP P,C ;Contact name + MOVEI D,15. ;Window size + MOVE B,A ;Host number or 0 + MOVEI A,RSICH ;Channel pair + JUMPE B,RSOPN2 ;Jump if listen + PUSHJ P,NETWRK"CHACON + JRST [ MOVEI A,[ASCIZ/Cannot connect to remote tape server/] + POPJ P, ] + JRST RSOPN3 + +RSOPN2: PUSHJ P,NETWRK"CHALSN + .LOGOUT 1, ;Nobody home +RSOPN3: MOVE T,[440700,,[ASCII/RECORD STREAM VERSION 1/]] + MOVEI TT,.LENGTH/RECORD STREAM VERSION 1/ + .CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? T ? SETZ TT ] + .LOSE %LSFIL + .IOT RSOCH,[215] + .NETS RSOCH, + MOVE A,[440700,,[ASCII/RECORD STREAM VERSION 1/]] + MOVEI B,.LENGTH/RECORD STREAM VERSION 1/ + SETZM PKTRBC +RSINI1: PUSHJ P,RSRBTI + ILDB TT,A + SKIPN TT + MOVEI TT,215 + CAME T,TT + PRTERR wrong record-stream identification text + SOJGE B,RSINI1 + SETZM PKTXBC + MOVE T,[440800,,PKTXBF+NETWRK"%CPKDT] + MOVEM T,PKTXBP + JRST POPJ1 ;Success return + +;--- Experiment to avoid hideously slow SIOKS3 +PKTXBF: BLOCK NETWRK"%CPMXW ;Packet transmit buffer +PKTXBP: 0 ;Byte pointer to PKTXBF +PKTXBC: 0 ;Byte count (valid bytes in packet) +PKTRBF: BLOCK NETWRK"%CPMXW ;Packet receive buffer +PKTRBP: 0 ;Byte pointer to PKTRBF +PKTRBC: 0 ;Byte count + +;Transmit record and force output +RSXMTF: PUSHJ P,RSXMT +RSXSND: PUSH P,A + MOVE A,PKTXBC + LSH A,4 + TLO A,(SETZ) + MOVEM A,PKTXBF + .CALL [ SETZ ? 'PKTIOT ? MOVEI RSOCH ? SETZI PKTXBF ] + .LOSE %LSSYS + SETZM PKTXBC + MOVE A,[440800,,PKTXBF+NETWRK"%CPKDT] + MOVEM A,PKTXBP + POP P,A + POPJ P, + +;Output byte from T, low volume +RSXBTO: AOS TT,PKTXBC + CAIG TT,NETWRK"%CPMXC + JRST [ IDPB T,PKTXBP + POPJ P, ] + SOS PKTXBC + PUSHJ P,RSXSND + JRST RSXBTO + +;Input byte to T, low volume + PUSHJ P,RSRRCV +RSRBTI: SOSGE PKTRBC + JRST .-2 + ILDB T,PKTRBP + POPJ P, + +;Receive next packet into PKTRBF +RSRRCV: .CALL [ SETZ ? 'PKTIOT ? MOVEI RSICH ? SETZI PKTRBF ] + .LOSE %LSSYS + MOVE T,[440800,,PKTRBF+NETWRK"%CPKDT] + MOVEM T,PKTRBP + LDB T,[NETWRK"$CPKNB+PKTRBF] + MOVEM T,PKTRBC + SKIPGE PKTRBF ;Skip if non-data packet + POPJ P, + LDB T,[NETWRK"$CPKOP+PKTRBF] + ; CAIN T,NETWRK"%COEOF ; Ignore EOFs fucking Unix sends... + ; JRST RSRRCV + ; Doesn't do any good if it also closes the channel... $%!$#^%!$%!! +;A little bit of useful non-modularity (knows we're inside DUMP) + SETZM LPTSW + PRINT _Non-data packet received: + POCT T + PRINT [ ] + CAIN T,NETWRK"%COCLS + PRINT [(CLS) ] + CAIN T,NETWRK"%COLOS + PRINT [(LOS) ] +RSRRC1: SOSGE PKTRBC + JRST ERR + ILDB T,PKTRBP + .IOT TYOC,T + JRST RSRRC1 + +;Transmit a record +;RSOCH - network output channel +;A - opcode +;B - 8-bit byte pointer to buffer containing record +;C - number of bytes in record +;Bashes A,B,C,T,TT +RSXMT: MOVE T,A ;Send opcode byte + PUSHJ P,RSXBTO + CAIGE C,1_15. ;Long count? + JRST RSXMT1 + MOVEI T,200 + PUSHJ P,RSXBTO + LDB T,[301000,,C] + PUSHJ P,RSXBTO + LDB T,[201000,,C] + PUSHJ P,RSXBTO +RSXMT1: LDB T,[101000,,C] ;Send high byte of count + PUSHJ P,RSXBTO + MOVE T,C ;Send low byte of count + PUSHJ P,RSXBTO +RSXMT2: JUMPLE C,CPOPJ + MOVEI T,NETWRK"%CPMXC + SUB T,PKTXBC ;Space remaining in buffer + CAMLE T,C + MOVE T,C + JUMPLE T,[ PUSHJ P,RSXSND ;Make space and try again + JRST RSXMT2 ] + ADDM T,PKTXBC ;Send this many + SUB C,T + PUSH P,C + MOVE A,PKTXBP + MOVE C,T + PUSHJ P,SCOPY ;Copy into buffer + MOVEM A,PKTXBP + POP P,C + JRST RSXMT2 + +;Copy string of 8-bit bytes +;Byte instructions are hideously slow on KS10 +;A - destination byte pointer +;B - source byte pointer +;C - number of bytes +;Bashes T,TT; advances arguments +SCOPY: JUMPLE C,CPOPJ ;Return if nothing left to do + TLNN A,300000 ;Skip if destination not word-aligned + CAIGE C,8 ;If fewer than two words, use slow loop + JRST SCOPY1 ;Copy one byte and try again + IBP A ;Point to first actual byte + IBP B + MOVE T,C + LSH T,-2 ;Number of words to do + ANDI C,3 ;Number of bytes left over + CAMGE B,[341000,,0] ;Skip if source is word-aligned + JRST SCOPY2 + HRLZ TT,B ;Both aligned, use BLT + HRR TT,A + ADD A,T + ADD B,T + BLT TT,-1(A) + JRST SCOPY4 ;Take care of residue, if any + +SCOPY1: ILDB T,B + IDPB T,A + SOJA C,SCOPY + +SCOPY2: PUSHAE P,[D,E] + LDB D,[360600,,B] ;Byte position of source + MOVEI TT,34 ;Compute left shift required to align it + SUB TT,D +SCOPY3: DMOVE D,(B) + LSH D,-4 ;Squeeze out extra bits + LSHC D,4(TT) ;Align source to destination + MOVEM D,(A) + ADDI A,1 + ADDI B,1 + SOJG T,SCOPY3 + POPAE P,[E,D] +SCOPY4: ADD A,[100000,,] ;Undo IBP + ADD B,[100000,,] ;.. + JRST SCOPY ;Take care of residue, if any + +IFN 0,[ +;Transmit record and force output +RSXMTF: PUSHJ P,RSXMT + .NETS RSOCH, + POPJ P, + +;Transmit a record +;RSOCH - network output channel +;A - opcode +;B - 8-bit byte pointer to buffer containing record +;C - number of bytes in record +RSXMT: .IOT RSOCH,A ;Send opcode byte + CAIGE C,1_15. ;Long count? + JRST RSXMT1 + .IOT RSOCH,[200] + LDB T,[301000,,C] + .IOT RSOCH,T + LDB T,[201000,,C] + .IOT RSOCH,T +RSXMT1: LDB T,[101000,,C] ;Send high byte of count + .IOT RSOCH,T + .IOT RSOCH,C ;Send low byte of count + .CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? B ? SETZ C ] + .LOSE %LSFIL + POPJ P, +];IFN 0 + +;Receive a record into buffer +RSRCVB: MOVE B,[440800,,BUFFER] + MOVEI C,MXRECB ;fall into RSRCV + +;Receive a record +;RSICH - network input channel +;A - opcode is returned here +;B - 8-bit byte pointer to buffer in which record is returned +;C - input: number of bytes in buffer, output: number of bytes in record +RSRCV: PUSHJ P,RSRBTI ;Await record and receive the opcode + PUSH P,T ;Save opcode + PUSH P,C ;Save buffer size + PUSHJ P,RSRBTI ;High byte of count + MOVE C,T + MOVEI TT,1 ;Normally one additional byte + TRNE C,200 + JRST [ MOVEI TT,4 ;Long count + MOVEI C,0 + JRST .+1 ] +RSRCV0: LSH C,8 + PUSHJ P,RSRBTI + IOR C,T + SOJG TT,RSRCV0 + CAMLE C,(P) + PRTERR Record-stream input buffer overflow--record too long + MOVEM B,(P) ;Save buffer pointer + PUSH P,C ;Save record length + SKIPA A,B ;Destination +RSRCV1: PUSHJ P,RSRRCV ;Get another packet + MOVE B,PKTRBP ;Source + PUSH P,C ;Save remaining record length + CAMLE C,PKTRBC + MOVE C,PKTRBC ;Only part of record is in this packet + MOVN T,C + ADDM T,PKTRBC ;Use up source and destination buffers + ADDM T,(P) + PUSHJ P,SCOPY ;Copy into caller's buffer + MOVEM B,PKTRBP + POP P,C ;Number of bytes still needed + JUMPG C,RSRCV1 + POP P,C ;Overall record length + POP P,B ;Original buffer pointer + POP P,A ;Opcode + POPJ P, + +IFN 0,[ +RSRCV: .IOT RSICH,A ;Await record and receive the opcode + PUSH P,C ;Save buffer size + .IOT RSICH,C ;High byte of count + MOVEI TT,1 ;Normally one additional byte + TRNE C,200 + JRST [ MOVEI TT,4 ;Long count + MOVEI C,0 + JRST .+1 ] +RSRCV0: LSH C,8 + .IOT RSICH,T + IOR C,T + SOJG TT,RSRCV0 + CAMLE C,(P) + PRTERR Record-stream input buffer overflow--record too long + MOVEM B,(P) ;Save buffer pointer + MOVE T,C + .CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSICH ? B ? SETZ T] + .LOSE %LSFIL + POP P,B + POPJ P, +];IFN 0 + + .END RTAPE + +SUBTTL DKAUTH, DKLOOK + +; Call with magic number in A, returns with SIXBIT of author in A. Author +; is looked up in the -local- MFD, so that better be what you want. +DKAUTH: PUSH P,B + SKIPN DKMFDP + JRST DKAUT1 +DKAUT2: MOVE B,MDNUDS+DSKMFD + SUB A,B + LSH A,1 + SKIPGE A + SKIPA A,DSKMFD+2000(A) + SETZI A, ; 0 if no author + POP P,B + POPJ P, + +DKAUT1: .IOPUSH DSKIN, + .CALL [ SETZ ? SIXBIT /OPEN/ + [.BII,,DSKIN] + [SIXBIT /DSK/] + [SIXBIT /M.F.D./] + SETZ [SIXBIT /(FILE)/]] + .LOSE %LSFIL + MOVE B,[-2000,,DSKMFD] + .IOT DSKIN,B + SKIPGE B + .LOSE + SETOM DKMFDP + .IOPOP DSKIN, + JRST DKAUT2 + +; Call with directory name in A, first name in B, second name in C, returns +; with pointer to name block in A. Fails to skip if file or directory not +; found. Uses the local filesystem, so that better be what you want. +DKLOOK: PUSH P,D + CAMN A,DKUFDP + JRST DKLOK1 + .IOPUSH DSKIN, + .CALL [ SETZ ? SIXBIT /OPEN/ + [.BII,,DSKIN] + [SIXBIT /DSK/] + [SIXBIT /.FILE./] + [SIXBIT /(DIR)/] + SETZ A ] + JRST [ .IOPOP DSKIN, ? JRST POPDJ ] + MOVE D,[-2000,,DSKUFD] + .IOT DSKIN,D + SKIPGE D + .LOSE + MOVEM A,DKUFDP + .IOPOP DSKIN, +DKLOK1: MOVE A,DSKUFD+UDNAMP + ADDI A,DSKUFD-LUNBLK +DKLOK2: ADDI A,LUNBLK + CAIL A,DSKUFD+2000 + JRST POPDJ + CAMN B,UNFN1(A) + CAME C,UNFN2(A) + JRST DKLOK2 + MOVE D,UNRNDM(A) + TLNE D,UNIGFL + JRST DKLOK2 +POPDJ1: AOS -1(P) +POPDJ: POP P,D + POPJ P, + + SUBTTL BUFFERS + +CONSTANTS +VARIABLES + +PATCH: +PAT: BLOCK LPAT + +PDL: BLOCK LPDL + +CLOADF: ;SAVE SWITCHES FOR 'CLOAD' COMMAND + -1 ;SAVE DMPMOD HERE + 0 ;SAVE RELOSW HERE + 0 ;SAVE LENGTH HERE + BLOCK NFIGS ;SAVE @FIGTB2(n) HERE + +MFDLST: BLOCK 1000 ;MUST BE IN THIS ORDER +BUF: BLOCK 2000 ;NORMAL BUFFER +DSKUFD: BLOCK 2000 .SEE DKLOOK ;UFD ON DISK +DSKMFD: BLOCK 2000 .SEE DKAUTH ;MFD ON DISK +UFDBUF: BLOCK 2000 ;STORAGE FOR INCOMING AND OUTGOING UFDS +MFDBUF: BLOCK 2000 ;STORAGE FOR TAPES COPY OF MFD +FDIRBF: BLOCK 2000+10 ;FOR FNG+POSSIBLE OVERFLOW +LISTBF: BLOCK 600. ;3 WORDS MAX 190. FILES, LISTING BUFFER +BIF: BLOCK 2000 ;COMPARE BUFFER +CORSIZ==<.+1777>_-10. +SORTAS: 0 +SBUF: ;FOR ORDMFD (SCOTT CUTLER MEMORIAL BUFFER) +CORSZB==<.+40000+1777>_-10. +BUFFER: 0 .SEE FCDMP + + END START diff --git a/src/sysnet/netwrk.266 b/src/sysnet/netwrk.266 new file mode 100755 index 00000000..96d44bed --- /dev/null +++ b/src/sysnet/netwrk.266 @@ -0,0 +1,2705 @@ +;-*- Mode:MIDAS; -*- + +; Netwrk subroutines +; Canonical location is [MIT-AI] SYSNET;NETWRK > +; All changes must be made or copied to this location, +; or they will be lost! +; +; New version partially fixed for HOSTS3, 2/17/83. --KLH +; ITS/20X version, 4/8/83. --Ian +; +; $$ARPA is understood to mean Internet; any address with NE%UNT off +; qualifies as an Internet address. +; +;*************************************************************************** +;******* In order to help clean things up and keep stuff working, +;******* please enter here the names of any programs you are aware of +;******* which insert this file! This will assure that future changes +;******* will not break your favorite software. +; AI:SYSENG;CRTSTY +; AI:SYSENG;TELSER +; AI:SYSEN1;HSTLOK +; AI:SYSEN1;PWORD +; AI:SYSEN1;UP +; AI:SYSEN2;PEEK +; AI:SYSEN2;TELNET +; AI:KSC;COMSAT +; AI:SYSNET;FTPS +; AI:SYSNET;FTPU +; AI:KSC;QMAIL +; MX:MT;NTELSUP +; AI:SYSEN1;SENDER +; AI:BAWDEN;PROBE +; AI:SYSENG;DUMP + + +IFNDEF ITS,[ + IFE .OSMID-SIXBIT/ITS/,ITS==1 + .ELSE ITS==0 +];IFNDEF ITS +IFNDEF 20X,[ + IFE .OSMID-SIXBIT/TWENEX/,20X==1 + .ELSE 20X==0 +];IFNDEF 20X +IFNDEF 10X,[ + IFE .OSMID-SIXBIT/TENEX/,10X==1 + .ELSE 10X==0 +];IFNDEF 10X +TNX==20X\10X ; This is the normally used switch. + +.AUXIL ;Don't mention all my symbols in crefs of programs that use me. + +.BEGIN NETWRK + +;Calling Conventions: +; +;All subroutines herein are called by PUSHJ P, +;and take their skip return if successful, non-skip if error. +;Arguments are passed in ACs A,B,C,D,E. ACs T and TT are freely smashable. +;However, "low level" subroutines generally take arguments and +;return values in T and TT and leave A-E alone. +;Subroutines may alter A-E as documented with each routine. +;The only ACs assumed are A,B,C,D,E,T,TT,P. TT=T+1 is assumed. +; +;The following externally defined symbols are assumed: +; +;GETCHR Routine to read character for HOSTNM/SYMGET routine. +; Returns in T, clobbers TT, skip return unless no chars available. +; +;PUTCHR Routine to write character for HOSTNM/SYMGET and ANALYZE routines. +; Char is passed in T (!!). Mustn't clobber any ACs. Never skips (!!). +; +;SPCHAN Routine to handle special characters for HOSTNM/SYMGET. +; Char is passed in T, number so far read in TT. +; Non-skip return to restart reader, skip to ignore char. +; +;DEBUG Nonzero if debugging. SERVE doesn't time out, and .VALUE'S +; if anything bad happens. +; +;The usual values for ITS predefined symbols are assumed. +; +;The NETWRK subroutines are enclosed in a MIDAS begin block to avoid +;confusion in the local tags. All code produced is pure. Any impure +;locations needed are created as MIDAS variables (eg, .VECTOR). + +;Print file version + .TYO6 .IFNM1 + .TYO 40 +IFN ITS,.TYO6 .IFNM2 +IFN TNX,[ +DEFINE TYPN ARG +PRINTX "ARG" +TERMIN +RADIX 10. + TYPN \.IFVRS +RADIX 8. +] ;TNX + PRINTX / included in this assembly. +/ + +qmtch==.qmtch ;In case the .INSRTer didn't have this set, turn it on so that +.qmtch==-1 ;we use "foo" construct, for other-assembler compatability. + +;The following symbols are used to select only necessary routines + +IFNDEF $$HST3, $$HST3==1 ; 1 = use HOSTS3 format and file. +IFNDEF $$HOSTNM, $$HOSTNM==0 ;Host name file lookup routines. +IFNDEF $$SYMGET, $$SYMGET==0 ;Interactive symbol input routine +IFNDEF $$SYMLOOK,$$SYMLOOK==0 ;table lookup routine. +IFNDEF $$HSTMAP, $$HSTMAP==0 ;HSTMAP, HSTUNMAP, HSTSRC host name table rts +IFNDEF $$HSTSIX, $$HSTSIX==0 ;Sixbit host name abbreviation +IFNDEF $$MIT, $$MIT==1 ;Flush "MIT-" in HSTSIX +IFNDEF $$OWNHST, $$OWNHST==0 ;Routine to get own host address +IFNDEF $$HSTCMP, $$HSTCMP==0 ;Routine to compare two host addresses +IFNDEF $$NETSRC, $$NETSRC==0 ;NETSRC routine to get network names +IFNDEF $$ICP, $$ICP==0 ;Initial Connection Protocol +IFNDEF $$SERVE, $$SERVE==0 ;Respond to an ICP (for a server) +IFNDEF $$SYSDBG, $$SYSDBG==0 ;ARPSRV, CHASRV shouldn't handle SYSDBG itself +IFNDEF $$CONNECT, $$CONNECT==0 ;Network Connection Routine (ARPCON, CHACON) +IFNDEF $$SIMPLE, $$SIMPLE==0 ;Simple-transaction for Chaosnet +IFNDEF $$ANALYZE, $$ANALYZE==0 ;Network Error Analysis Routine +IFNDEF $$ERRHAN, $$ERRHAN==0 ;Automatic ANALYZE in ARPCON, CHACON, etc. +IFNDEF $$LOGGING, $$LOGGING==0 ;Network library usage logging +IFNDEF $$UPTM, $$UPTM==1 ;ANALYZ should give estimated time up again +IFNDEF $$CVH, $$CVH==0 ;1 to include host number conversions + +IFNDEF $$LOOK, $$LOOK==0 ;1 to support no network (just lookups) +IFNDEF $$CHAOS, $$CHAOS==0 ;1 to support Chaosnet hosts and rtns +IFNDEF $$ARPA, $$ARPA==0 ;1 to support Arpanet hosts and rtns +IFNDEF $$TCP, $$TCP==0 ;1 to support /TCP switch & routines +IFN $$TCP*$$SYMLOOK,[ + $$ARPA==1 ;arpa must be set for TCP to work here + ] +IFNDEF $$ALLNET,[ ; 1 for lookup rtns to support all nets + IFE $$HST3,$$ALLNET==0 ; Including ones ITS doesn't handle. + .ELSE $$ALLNET==$$ARPA + ] + +IFN $$ARPA,[ +IFNDEF ARPHST, .SCALAR ARPHST +] + +IFN $$TCP,[ +IFNDEF USENCP, .SCALAR USENCP +IFNDEF USETCP, .SCALAR USETCP + ] + +IFNDEF $$PROMPT, $$PROMPT==1 ;1 to use default prompt "Host: " +IFNDEF $$TCPTO, $$TCPTO==15.*30. +IFNDEF $$CHATO, $$CHATO==15.*30. + +;;; Summary of entry-points and calling sequences. +;;; Note that all routines listed here skip-return on success, clobber T and TT. +;;; +;;; SYMGET(E:table_p) => A:symbol_value, B,C,D,E:junk +;;; SYMLOOK(A:input, E:table_p) => B:result_descr, T:numeric_value +;;; HSTMAP(A:page#, B:channel#) => RH(A):next_free_page +;;; HSTUNMAP() +;;; HSTSRC(B:host#) => A:TIP_flag,,name_p, D:site_p +;;; HOSTNM() => A:host#, TT:network#, B,C,D,E:junk +;;; HSTLOOK(A:input) => A:host#, TT:network#, B:result_desc, E:junk +;;; HSTSIX(A:host#) => A:sixbit_host_name +;;; OWNHST(A:network#) => A:host# (address of this machine on that network) +;;; HSTCMP(A:host#,B:host#) => skip iff 2 hosts are the same +;;; NETSRC(B:net#) => A:name_p +;;; ARPICP(A:pin#, B:host#, C:socket#, D:imode,,omode) => clobbers all, opens pin+2,pin+3 +;;; ICPASN(A:pin#, B:host#, C:socket#, D:imode,,omode, E:phase#) +;;; ARPSRV(A:pin#, B:socket#, C:imode,,omode) => B:host#, C:sysdbg, A,D:junk, opens pin+2,+3 +;;; ARPCON(A:pin#, B:host#, C:frn_socket#, D:async,,mode) +;;; CONFIN(A:pin#, , , D:mode) +;;; CHASRV(A:channel#, C:contact_name_p, D:window_size) => B:host#, C:sysdbg, A,D:junk +;;; CHACON(A:channel#, B:host#, C:contact_name_p, D:window_size) +;;; CHASMP(A:channel#, B:host#, C:request, D:answer) +;;; CHALSN(A:channel#, B:zero_or_host#, C:contact_name_p, D:window_size) +;;; TCPCON(A:channel#, B:host#, C:port#) +;;; TCPSRV(A:channel#, B:port#) => B:host#, C:sysdbg, A,D:junk +;;; ANALYZE(A:channel#) => prints error message, with no CRLF + +IFE $$LOOK+$$CHAOS+$$ARPA, .FATAL You have to specify at least one network +IFN $$ERRHAN,$$ANALYZE==1 +IFN $$SYMGET,$$SYMLOOK==1 +IFN $$HOSTNM,$$HSTMAP==1 +IFN $$HSTCMP,$$HSTMAP==1 +IFN $$SIMPLE,$$CONNECT==1 + +DEFINE $$LOG +IFN $$LOGGING!TERMIN + +$$LOG,[ +IFE ITS, .ERR Sorry the LOGging feature is only supported under ITS +;;; For logging connections. Example: LOG OPEN,[B,C] +DEFINE LOG NETOP,CRUFT +%%ZZ==1 +PUSHJ P,[ PUSH P,A + PUSH P,[SIXBIT /NETOP/] + IRP CRUFTY,,[CRUFT] + MOVE A,CRUFTY + PUSH P,A + %%ZZ==%%ZZ+1 + TERMIN + MOVEI A,%%ZZ + PUSHJ P,NETWRK"LOGACT + REPEAT %%ZZ, POP P,A + POP P,A + POPJ P, ] +TERMIN +];$$LOG + +NE%UNT==:<1_32.> ; Escape bit indicating non-Internet address +IFN $$HST3,[ +NW$BYT==:301400 ; Byte pointer to network number (approx!) +NE%STR==:<1_33.> ; Escape bit indicating string-type address + ; Useful HOSTS3 full word network # values +NW%CHS==:> ; CHAOSNET +NW%ARP==:<10._24.> ; ARPANET +NW%MIL==:<26._24.> ; MILNET +NW%LCS==:<18._24.> ; MIT-LCS (18) +NW%AI==:<20015,,> ; MIT-AI-NET (128.52) + +; Corresponds to kludge in HOSTS3 that reduces the size of the network table. +DEFINE GETNET AC,(ADDR) +IFNB [ADDR] MOVE AC,ADDR + TDZ AC,[<1_24.>-1] +TERMIN + +IFN 0,[ +DEFINE GETNET AC,(ADDR) +IFNB [ADDR] MOVE AC,ADDR + TLNN AC,(17_32.) ; Check for non-Internet type addrs + TLNN AC,(1_31.) ; Internet address, see if class A net + TDZA AC,[77,,-1] ; Unternet or class A, zap low 3 octets + TLNN AC,(1_30.) ; Class B or C, see which. + TRZA AC,177777 ; Class B network, zap low 2 octets + TRZ AC,377 ; Class C net, only zap 1 low octet +TERMIN +] ;IFN 0 + +] ;$$HST3 +.ELSE [ ; HOSTS2 format stuff +NW%CHS==:7 ;Chaos net +NW%ARP==:12 ;Arpa net +NW%LCS==:22 ;LCS net +;NW%DLN==:26 ;Dial net (not supported by these routines) +NW$BYT==:331000 ; Byte pointer to network number + +DEFINE GETNET AC,(ADDR) + LDB AC,[NW$BYT,,ADDR] +TERMIN +] ;HOSTS2 + +IFN $$CHAOS,[ + IFNDEF $CPKOP,[ + IFN ITS, .INSRT SYSENG; CHSDEF > + .ELSE .INSRT SYSTEM:CHSDEF + ] +] +IFN ITS,[ +.CALL==43_33 ;IN CASE OUR .INSRT'ER USES CALRET .CALL MACRO. +DEFINE SYSCAL NAME,ARGS +.CALL [SETZ ? SIXBIT /NAME/ ? ARGS ((SETZ))] +TERMIN +];ITS + +POP2J: SUB P,[1,,1] ;Exits used in a few places. +POP1J: SUB P,[1,,1] +CPOPJ: POPJ P, + +POPJ1: AOS (P) + POPJ P, + +IFNDEF NWLOSS,[ ; SO .INSRT'ER CAN SUBSTITUTE SOMETHING FOR LOSSAGE CHKS +IFN ITS,[ +DEFINE NWLOSS + .LOSE +TERMIN +];ITS +IFN TNX,[ +DEFINE NWLOSS + HALTF +TERMIN +];TNX +];NWLOSS + +IFN $$SYMGET+$$SYMLOOK,[ +.SCALAR HSTNMF ;Document these! +.SCALAR NOABRV +.SCALAR NTSPCF +] + +IFN $$SYMGET,[ + +;Interactive symbol readin and lookup. +; +; Call: MOVE E,TABLEP +; PUSHJ P,SYMGET +; error +; value of symbol now in A. +; +;Smashes B, C, D, E, T, TT. +; +; TABLEP should be an aobjn ptr to the table +; of symbols from which user input is to select. +; Num is an arbitrary 18-bit field derived from the table. +; The format of the table is: +; [asciz/prompt string/] +; --> value1,,[asciz/upper-case-symbol-1/] +; value2,,[asciz/upper-case-symbol-2/] +; . . . +; Note that this table is an argument to the SYMGET entry. The +; HOSTNM entry uses the table from the HOSTS3 file, not in the same format. +; +;Subroutines used: +; GETCHR, PUTCHR, SPCHAN (see previous page for call sequences) +; +; GETCHR subroutine to get a character (1 arg) +; PUTCHR subroutine to type a character (1 arg). +; input is echoed/completed through PUTCHR +; SPCHAN if a character other than a letter, a number, +; a hyphen, a period, a space, or a CR is seen, +; SPCHAN is called with the char in T. Variable NUMGOT +; will have value of number read thus far (-1 if none). +; Non-skip return restarts reader, skip return ignores char +; and continues. +; + +.VECTOR RCPBUF(6) ;input buffer for this routine +.SCALAR CHRCNT,NUMGOT + +;Register Usage +; +;A octal host number accum - scratch, if reading name. +;B decimal host number accum - scratch, if reading name. +;C scratch. +;D byte pointer into input buffer +;E (aobjn) pointer to table +;T character or random data +;TT miscellany + +IFN $$PROMPT,[ +PROMPT: [ASCIZ /Host: /] ; default prompt +]; IFN $$PROMPT + +SYMGET: ;interactive symbol input routine, with completion. + SETZM HSTNMF ;Say we are not using the host names table (it has no prompt string). +HSTNM1: REGO: + SKIPN HSTNMF + SKIPA TT,-1(E) ;prompt + MOVE TT,PROMPT + PUSHJ P,ZTYPE +GO3A: MOVEI D,RCPBUF ;PTR TO SPEC STRING + HRLI D,440700 ;PTR INTO COLLECTED STRING + SETZM CHRCNT ;COUNT OF CHARS IN STRING + SETOM NUMGOT ; Value of number read thus far + +GO1: PUSHJ P,GETCHR ;GET INPUT CHARACTER + MOVEI T,^M ;NO CHARS AVAIL SAME AS A CR. + JUMPE T,GO1 ;IGNORE NULLS. + CAIL T,"a" + CAILE T,"z" + CAIA ;NOT LOWER CASE + SUBI T,40 ;CONVERT LOWER CASE TO UPPER + CAIE T,12 + CAIN T,15 + JRST GOTRM ;E-O-L MEANS USER DONE WITH SPEC. + CAIN T,40 + JRST GOTRM0 ;SPACE COMPLETE BUT DON'T TERM + CAIN T,177 ;RUBOUT CAUSES COMPLETE RESTART + JRST [ MOVEI TT,[ASCIZ\? +\] ? PUSHJ P, ZTYPE + JRST REGO ] + CAIE T,"?" + CAIN T,33 ;? OR ALT MEANS LIST ALL POSSIBLE HOSTS, + JRST GOTALT ;GIVEN TYPEIN THUS FAR. + JRST GOTC + +BAD1: SUB P,[1,,1] +BAD: MOVEI T,7 ;IF BAD CHAR GIVEN, DING BELL. +GOECH: PUSHJ P,PUTCHR + JRST GO1 + +;GOT A CHARACTER. IS EITHER SPECIAL OR PART OF A NAME + +GOTC: CAIN T,"-" ;BY SPECIAL DISPENSATION, HYPHEN + JRST GOTC00 + CAIN T,"." ; Also allow period as part of name + JRST GOTC00 + CAIN T,"/" ;SLASH AT THIS LEVEL IS JUST A CHARACTER + JRST GOTC00 ;SYML1 WILL HANDLE HOST/IMP AND ADDRESS/NETWORK-NAME CONSTRUCTS + CAIGE T,"0" ;NUMBERS + JRST SPECL + CAIG T,"9" + JRST GOTC00 + CAIGE T,"A" ;LETTERS + JRST SPECL + CAIG T,"Z" + JRST GOTC00 +;OTHERWISE SPECIAL CHARACTER, HANDLE IT +SPECL: MOVE TT,A + PUSHJ P,SPCHAN + JRST GO3A ;RESTART FROM THE BEGINNING + JRST GO1 ;IGNORE THIS CHAR + +;GOT A CHAR. STORE IF IT PLUS STRING THUS FAR MATCHES A NAME, DON'T STORE IF NOT. +;CHAR (NOT ECHOED YET) IS IN T. +GOTC00: PUSH P,D ;PREPARE TO FLUSH THE CHAR IF IT MAKES AN UNDEF SYMBOL. + IDPB T,D ;STORE CHAR IN STRING, FOLLOWED BY A NULL. + PUSH P,D + SETZ TT, + IDPB TT,D + POP P,D + AOS CHRCNT ;INCREMENT COUNT OF CHARS IN STR. + PUSH P,T + MOVEI A,RCPBUF + PUSHJ P,SYML1 ;SEARCH THE TABLE FOR THIS STRING. + JFCL + CAIGE B, + MOVEM T,NUMGOT ; Store number got thus far. + POP P,T + POP P,TT + JUMPN B,GOECH ;NUMBER, OR SYMBOL FOUND OR AMBIGUOUS => THIS CHARACTER IS OK. + SETZ TT, ;SYMBOL UNDEFINED => ZERO OUT THIS CHAR IN THE STRING + DPB TT,D + MOVE D,TT ;BACK UP POINTER TO END OF STRING + SOS CHRCNT + JRST BAD ;AND COMPLAIN. + +;GOT A E-O-L, SEE IF HAVE ENOUGH OF NAME TO RENDER IT UNIQUE. +GOTRM: TDZA C,C ;COMPLETE AND TERMINATE +GOTRM0: SETOM C ;JUST COMPLETE + SKIPG CHRCNT ;HMMM, ANYTHING IN STRING STORED? + JRST BAD ;NO, DING... + MOVEI A,RCPBUF ;ELSE LOOK THE STRING UP. + PUSHJ P,SYML1 + JRST BAD ;UNDEFINED OR AMBIGUOUS => LOSE. + MOVE A,T + MOVE TT,B ;NUMBER => OK, AND DON'T TYPE ANYTHING. RETURN NUMBER IN A. + AOJE TT,WIN + HRRZ TT,(B) ;FOUND AND UNAMBIGUOUS. COMPLETE THE NAME IF ABBREVIATED. + SKIPE HSTNMF + ADD TT,HSTADR ;GET POINTER TO THE FULL NAME. + HRLI TT,440700 + MOVE A,CHRCNT + ILDB T,TT ;IGNORE AS MANY CHARS AS THE USER ACTUALLY GAVE. + JUMPE T,GOTRM2 ;HANDLE USER ABBREVIATION AND /NET FORMS RIGHT + SOJG A,.-2 +GOTRM1: ILDB T,TT + JUMPE T,GOTRM2 + IDPB T,D ;AS WE COMPLETE THE NAME, STORE THE CHARS INTO THE ARG + AOS CHRCNT ;SO THAT IF THIS IS A SPACE, THE FOLLOWING CR DOESN'T + PUSHJ P,PUTCHR ;TYPE THE SAME STUFF OUT AGAIN. + JRST GOTRM1 + +GOTRM2: HLRZ A,(B) ;WIN. RETURN LH. OF TABLE WORD. + SKIPE HSTNMF ;NORMALLY IS SYMBOL VALUE, BUT IF READING HOST NAME, IS FILE- + SETO TT, ;RELATIVE ADDRESS OF SITE TABLE ENTRY, TT NON-ZERO MEANS NOT NUMBER +WIN: JUMPN C,GO1 ;SHOULD TERMINATE? NO => GO READ MORE CHARS. + PUSHJ P,CRLF ;YES, GIVE CRLF + JRST POPJ1 ;AND RETURN WINNING NUMBER IN A + +;GOT ? OR ALT, LIST ALL NAMES POSSIBLE AT THIS STAGE. +GOTALT: SKIPN CHRCNT + JRST GO1 ;ALTMODE OR ? AFTER A NUMBER IS A NO-OP. + MOVEI A,RCPBUF + SETOM NOABRV + PUSHJ P,SYMLA ;SEARCH FOR ALL POSSIBLE ALTERNATIVES. + JFCL + TLNN B,-1 + HRLS B ;IF ONLY ONE, SET IT UP AS RANGE ,,. + MOVE TT,B + AOJE TT,GO1 ;IF ARG IS A NUMBER, DON'T TYPE ANYTHING. + PUSHJ P,CRLF + HLRZ A,B ;A POINTS TO FIRST, RH(B) POINTS TO LAST. +GOTAL1: HRRZ TT,(A) ;GET THE ADDR OF THE NEXT POSSIBLE MATCH'S NAME STRING + SKIPE HSTNMF + ADD TT,HSTADR + PUSHJ P,ZTYPE ;TYPE IT. + PUSHJ P,CRLF + ADDI A,1 + CAIG A,(B) + JRST GOTAL1 + SKIPN HSTNMF ;GIVE PROMPT STRING AGAIN + SKIPA TT,-1(E) + MOVE TT,PROMPT + PUSHJ P,ZTYPE + MOVEI TT,RCPBUF ;FOLLOWED BY THE ARG CHARS WE HAVE SO FAR. + PUSHJ P,ZTYPE + JRST GO1 + +] ;END IFN $$SYMGET + +IFN $$SYMLOOK,[ + +; SYMLOOK - Non-incremental hostname/hostaddr (symbol) lookup routine +; called by the incremental one. +;Numbers are normally octal, but a "." at the end implies decimal. +;Decimal host slash decimal Imp and any address slash network name are allowed. +; The decimal "octet" form is allowed, right justified. +;In the address slash network-name form, the argument is smashed then restored! +; + ; A/ ; Can also be 0,, or -1,, +; E/ ; e.g. -tablelen,,table +; Returns .+1 if fail: +; B/ 0 for an undefined sym, or ,, for an ambiguous one. +; Returns .+2 if won: +; B/ addr of table entry for symbol we found. +; or -1 if argument was a number; value returned in T. +; Clobbers T, TT. + +SYMLOOK: + SETZM HSTNMF +SYML1: SETZM NOABRV +SYMLA: PUSH P,C + PUSH P,D + HLRZ TT,A + SKIPE TT ;If A is an address, + CAIN TT,-1 ;or HRROI-style TWENEX string pointer, + HRLI A,440700 ;then turn into canonical PDP-10 BP + MOVE TT,A + MOVE T,A + ILDB T,T ;First character of string + CAIL T,"0" ;Is the argument a number (starts with a digit)? + CAILE T,"9" + JRST SYML6 + SETZB C,D ;Yes => accumulate octal number in C, decimal in D. +SYML7: ILDB T,TT + CAIL T,"0" + CAILE T,"9" + JRST SYML8 + IMULI C,10 + IMULI D,10. + ADDI C,-"0"(T) + ADDI D,-"0"(T) + JRST SYML7 + +SYML8: CAIN T,"/" + JRST SYMSL1 ;Digits followed by slash + CAIE T,"." ;Out of digits => "." means use the decimal number + JRST SYML9 ;(else use the octal). + MOVE C,D + ILDB T,TT + CAIN T,"/" ;OK to have both a decimal point and a slash + JRST SYMSL1 + JUMPE T,SYML9 + CAIL T,"0" ; Another number? + CAILE T,"9" + JRST SYML9 + + ; Aha, have num.num so keep going in this vein. + MOVEI D,-"0"(T) ; Initialize D with 1st digit of 2nd number +SYML41: ILDB T,TT + CAIL T,"0" + CAILE T,"9" + JRST [LSH C,8. + ADDI C,(D) + SETZ D, + CAIN T,"." + JRST SYML41 + CAIN T,"/" + JRST SYMSL1 + JRST SYML9] + IMULI D,10. + ADDI D,-"0"(T) + JRST SYML41 + +SYML9: JUMPN T,SYMUND ;Any stray chars after the last digit or the "." => error. + MOVE T,C + SETO B, ;Return the number in T and -1 (=> this is a number) in B. + JRST SYMWIN + +SYMSL1: SKIPN HSTNMF ;Slash only magic if hacking hosts + JRST SYML9 + ILDB T,TT ;Look at character after slash + CAIL T,"0" + CAILE T,"9" + JRST [ADD TT,[070000,,] ; Back up byte-pointer + PUSHJ P,SYMSL4 ; Process slash network-name. + SETZ T, + JRST SYML9 ] + +IFE $$ARPA, JRST SYML9 +IFN $$ARPA,[ + MOVE C,D ;Number slash number, use decimal + MOVEI D,-"0"(T) +SYMSL2: ILDB T,TT + CAIL T,"0" + CAILE T,"9" + JRST [ +IFN $$HST3,[ LSH C,16. ? DPB D,[002000,,C] ; Move HOST over and add IMP + ADD D,[NW%ARP] + MOVE TT,[NW%ARP] + MOVEM TT,NTSPCF + +];$$HST3 +.ELSE [ DPB D,[112000,,C] ;Deposit IMP number into HOST number + MOVEI D,NW%ARP ;And this is obviously Arpa net + DPB D,[NW$BYT,,C] +];HOSTS2 + JRST SYML9 ] + IMULI D,10. + ADDI D,-"0"(T) + JRST SYMSL2 +];$$ARPA + + +;;Subroutine to read network name and set NTSPCF to network number +;; Note if HOSTS3 this is a full-word value. +IFE $$ALLNET,[ + +SYMSL4: MOVEI D,0 +SYMSL5: ILDB T,TT + JUMPE T,SYMSL6 + LSH D,6 + CAIL T,"a" + SUBI T,40 + IORI D,-40(T) + JRST SYMSL5 + +SYMSL6: IRPS FLAG,,[$$CHAOS $$ARPA $$TCP $$TCP + ]NAME,,[CHAOS ARPA TCP NCP + ]NUM,,[NW%CHS NW%ARP NW%ARP NW%ARP] +IFN FLAG,[ ;Make sure we claim to support this network + MOVE TT,[SIXBIT \NAME\] + PUSHJ P,SYMSXC + MOVE T,[NUM] ;Prefix -- set it +];FLAG + TERMIN +IFN $$TCP,[ + MOVE TT,[SIXBIT \TCP\] + PUSHJ P,SYMSXC + JRST [ SETOM USETCP + SETZM USENCP + JRST .+1] + MOVE TT,[SIXBIT \NCP\] + PUSHJ P,SYMSXC + JRST [ SETOM USENCP + SETZM USETCP + JRST .+1] +] + JUMPE T,[POP P,T ? JRST SYMUND] ;Unknown network name, barf + MOVEM T,NTSPCF + POPJ P, + +;; Compares sixbit arg in D with sixbit Network name in TT. +;; Returns .+1 if arg is prefix of net name +;; .+2 otherwise + +SYMSXC: PUSH P,D + JUMPE D,SYMSX1 ; Don't loop forever if arg is 0 + TLNN D,770000 ; Shift until high byte is non-zero + JRST [ LSH D,6 ? JRST .-1 ] + TRNN D,77 ; Shift both until low char non-zero + JRST [ LSH D,-6 ? LSH TT,-6 ? JRST .-1 ] + CAMN D,TT + CAIN D,0 +SYMSX1: AOS -1(P) + POP P,D + POPJ P, + +];$$ALLNET +IFN $$ALLNET,[ +;; Like SYMCMP, but user's string needn't start on word boundary. +;; Compare strings, address of one in T, Byte Pointer to another in C. +;; Smash T, TT, but NOT A, B, C, or D + +SYMCMC: PUSH P,C + PUSH P,D + PUSHJ P,SYMCM0 ;Do comparison w/o setting up C + CAIA + AOS -2(P) ; Success, skip return + POP P,D + POP P,C + POPJ P, + +SYMSL4: PUSH P,C + MOVE C,TT ;ptr to string + MOVE T,HSTADR + ADD T,NETPTR(T) ;Ptr to network tables + MOVN D,(T) ;Count of networks + HRLZS D ;Prepare AOBJN ptr + HRRI D,2(T) ;Ptr to first network +SYSL4A: HLRZ T,NTLNAM(D) ;Ptr to host string + ADD T,HSTADR + PUSHJ P,SYMCMC ;Is this the network we were given? + JRST SYSL4B ; Nope, try next + + MOVE T,NETNUM(D) ;Get the network number + MOVEM T,NTSPCF ;Remember that we specified it + POP P,C + POPJ P, + +SYSL4B: MOVE T,HSTADR ;Find start of NETWORK table + ADD T,NETPTR(T) + ADD D,1(T) ;2nd word is size of entries + ADD D,[1,,0] ;Update the counter + JUMPL D,SYSL4A ;Try next match + POP P,C + POP P,(P) + JRST SYMUND ;Else fail. + +]; $$ALLNET + +;Here to start processing an arg which is not a number. +SYML6: MOVE B,E + ILDB T,TT ;Check for slash and network name + JUMPE T,SYML2 ;None found + CAIE T,"/" + JRST SYML6 + MOVEI T,0 ;Ugh, barf, clobber the argument + DPB T,TT + PUSH P,TT + PUSHJ P,SYMLA ;Go do that + JRST [ POP P,TT ? MOVEI T,"/" ? DPB T,TT ? JRST SYMLZ] ;Lost, propagate, fixing arg + POP P,TT ;Note, recursive call didn't return anything in T + MOVEI T,"/" ; since this wasn't a number + DPB T,TT ;Fix argument + PUSH P,TT ;Don't barf at / with nothing after it yet + ILDB T,TT + POP P,TT + CAIE T,0 + PUSHJ P,SYMSL4 ;Process network-name argument + JRST SYMWIN ;And take success return + +SYML2: HRRZ T,(B) ;Get the next symbol's name from the table. + SKIPE HSTNMF + ADD T,HSTADR + PUSHJ P,SYMCMP ;Does the argument in A abbreviate it? + CAIA + JRST SYML3 ;Yes, we have found the first match. + AOBJN B,SYML2 +SYMUND: SETZ B, ;There is no match. Return 0. + JRST SYMLZ + +SYML3: PUSH P,B ;Remember where the first match is, and find the last. +SYML4: AOBJP B,SYML5 + HRRZ T,(B) ;Get the next symbol's name from the table. + SKIPE HSTNMF + ADD T,HSTADR + PUSHJ P,SYMCMP ;Does the argument in A abbreviate it? + JRST SYML5 ;No => we have gone past the last match. + JRST SYML4 + +SYML5: SUB B,[1,,1] ;B points at last match. + CAMN B,(P) ;Last and first match are the same table entry? + JRST SYMLW ;Then that one is the value. + MOVE TT,(P) + PUSH P,A + HLLZ A,(B) +SYML5A: HLLZ T,(TT) + CAME T,A + JRST SYML5B + CAME TT,B + AOBJN TT,SYML5A ;If all names have the same value, then just + MOVEM B,-1(P) ;return the last name, e.g. for XEROX.ARPA + JRST SYMLW1 ;and XEROX.COM, return XEROX.COM + +SYML5B: MOVE A,-1(P) ;A gets the symbol name of the first match + HRRZ A,(A) + SKIPE HSTNMF + ADD A,HSTADR + HRLI A,440700 + HRRZ T,(B) + SKIPE HSTNMF ;and T gets the name of the last match. + ADD T,HSTADR + SKIPN NOABRV ;If processing "BBN?", show all names starting with BBN + ;even though "BBN" by itself is a valid name. + PUSHJ P,SYMCMP ;if the first match is an abbreviation of the last, + JRST SYMLL +SYMLW1: POP P,A ;then it's no ambiguity; the first wins. +SYMLW: POP P,B + ANDI B,-1 +SYMWIN: POP P,D + POP P,C + JRST POPJ1 + +SYMLL: POP P,A ;Here if argument is really ambiguous. + HRL B,(P) ;produce 1st match addr,,last match addr. + SUB P,[1,,1] +SYMLZ: POP P,D + POP P,C + POPJ P, + +;Compare the ASCIZ string <- A with the one <- T. +;Skip if the one in A is an initial segment of the one in T. +;We clobber C, D, T and TT but NOT A. + +SYMCMP: MOVE C,A +; HRLI C,440700 ;Already a BP now. +SYMCM0: HRLI T,440700 +SYMCM1: ILDB TT,T + ILDB D,C + JUMPE D,POPJ1 ;1st string ended and no mismatch => win. + CAIL D,140 + SUBI D,40 ;Ignore case in the string in A. Assume string in T is all upper. + CAME D,TT + POPJ P, ;mismatch => lose. + JRST SYMCM1 + +IFE $$HSTMAP,.SCALAR HSTADR + +] ;end IFN $$SYMLOOK + +IFN $$HSTMAP,[ + +.SCALAR HSTADR ;Address of HOSTS3 file is stored here. +.SCALAR HSTABN ; AOBJN page pointer to HOSTS3 + +;The format of the compiled HOSTS3 file is: +; NOTE THIS IS NOT COMPLETELY ACCURATE. See the file +; AI:SYSNET;HOSTS3 > for an uptodate description. +HSTSID==:0 ; wd 0 SIXBIT /HOSTS3/ +HSTFN1==:1 ; wd 1 SIXBIT /HOSTS/ usually +HSTVRS==:2 ; wd 2 FN2 of HOSTS file which this was compiled from. +HSTDIR==:3 ; wd 3 SIXBIT /SYSENG/ usually, directory name of source file +HSTMCH==:4 ; wd 4 SIXBIT /AI/ (e.g.), device name of source file +HSTWHO==:5 ; wd 5 UNAME of person who compiled this +HSTDAT==:6 ; wd 6 Date of compilation as sixbit YYMMDD +HSTTIM==:7 ; wd 7 Time of compilation as sixbit HHMMSS +NAMPTR==:10 ; wd 10 Address in file of NAME table. +SITPTR==:11 ; wd 11 Address in file of SITE table. +NETPTR==:12 ; wd 12 Address in file of NETWORK table. + ;....expandable.... + +;NETWORK table +; wd 0 Number of entries in table. +; wd 1 Number of words per entry. (2) +;This table contains one entry for each network known about, sorted +;by network number. A network number is bits 4.8-4.1 of a network +;address; these numbers are assigned by Jon Postel. See symbols below. +;The reason for keeping track of different networks is that the user +;program must make different system calls to use each network. +;Each entry contains: +NETNUM==:0 ; wd 0 network number +NTLNAM==:1 ; wd 1 LH - address in file of name of network +NTRTAB==:1 ; wd 1 RH - address in file of network's address table + +;ADDRESS table(s) +; wd 0 Number of entries in table. +; wd 1 Number of words per entry. (2) +;There is one of these tables for each network. It contains entries +;for each site attached to that network, sorted by network address. +;These tables are used to convert a numeric address into a host name. +;Also, the list of network addresses for a site is stored +;within these tables. +;Each entry contains: +ADDADR==:0 ; wd 0 Network address of this entry (including network number). +ADLSIT==:1 ; wd 1 LH - address in file of SITE table entry +ADRCDR==:1 ; wd 1 RH - address in file of next ADDRESS entry for this site + ; 0 = end of list +ADRSVC==:2 ; wd 2 RH - fileaddr of services list for this address + ; 0 none, else points to SERVICE node of format + SVLCNT==:0 ; <# wds>,, + SVRCDR==:0 + SVLFLG==:1 ; ,, + SVRNAM==:1 + SVCARG==:2 ; Possible additional parameters + +;SITE table +; wd 0 Number of entries in table. +; wd 1 Number of words per entry. (3) +;This table contains entries for each network site, +;not sorted by anything in particular. A site can have more +;than one network address, usually on different networks. +;This is the main, central table. +;Each entry looks like: +STLNAM==:0 ; wd 0 LH - address in file of official host name +STRADR==:0 ; wd 0 RH - address in file of first ADDRESS table entry for this + ; site. Successive entries are threaded together + ; through ADRCDR. +STLSYS==:1 ; wd 1 LH - address in file of system name (ITS, TIP, TENEX, etc.) + ; May be 0 => not known. +STRMCH==:1 ; wd 1 RH - address in file of machine name (PDP10, etc.) + ; May be 0 => not known. +STLFLG==:2 ; wd 2 LH - flags: +STFSRV==:400000 ; 4.9 1 => server site (according to NIC) +STFGWY==:200000 ; 4.8 1 => Internet gateway site + ; wd 2 RH - not used + +;NAMES table: +; wd 0 Number of entries +; wd 1 Number of words per entry. (1) +;This table is used to convert host names into network addresses. +; Followed by entries, sorted by the host name treated as a vector of +; signed integers, looking like: +NMLSIT==:0 ; lh address in file of SITE table entry for this host. +NMRNAM==:0 ; rh address in file of host name + ;This name is official if NMRNAM = STLNAM of NMLSIT. + +; All names are ASCIZ strings, all letters upper case. +; The strings are stored before, after and between the tables. +; All strings are word-aligned, and fully zero-filled in the last word. + +;Network addresses are defined as follows, for purposes of this table: +; 4.9 0 +; 4.8-4.1 network number +; Chaos net (number 7): +; 3.9-2.8 0 +; 2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host) +; Arpa net (number 12): (note, old-format Arpanet addresses +; 3.9-3.8 0 never appear in the host table.) +; 3.7-2.1 Imp +; 1.9 0 +; 1.8-1.1 Host + +;Map the host table file SYSBIN;HOSTS3 > into core. +;A should contain the page number to start it at. +;B should contain the channel number to use. +;We skip if we succeed, returning in RH(A) the number of the first page not used up. +HSTMAP: +IFN ITS,[ + SYSCAL OPEN,[ B ? 5000,,.BII ? ['DSK',,] +IFN $$HST3, ['HOSTS3'] +.ELSE ['HOSTS2'] + [SIXBIT />/] ? ['SYSBIN']] + POPJ P, + SYSCAL FILLEN,[B ? 2000,,T] + POPJ P, + JUMPLE T,CPOPJ + MOVEI T,1777(T) ;(round up) + LSH T,-10. + PUSH P,A + LSH A,10. + MOVEM A,HSTADR ;Save in HSTADR the address where we are mapping the file. + POP P,A + MOVNS T ;form AOBJN page ptr for CORBLK + HRL A,T + MOVEM A,HSTABN ; save AOBJN for unmapping + SYSCAL CORBLK,[ 1000,,%CBNDR ;Read-Only. + 1000,,%JSELF ;into self + A ;as specified + B] ;from file open on channel. + POPJ P, + SYSCAL CLOSE,B + POPJ P, + MOVE T,HSTADR +];ITS +IFN TNX,[ +.SCALAR HSTJFN +.SCALAR HSTLEN + + PUSH P,1 ? PUSH P,2 ? PUSH P,3 + PUSH P,A + MOVSI 1,(GJ%SHT\GJ%OLD) +IFN 20X,[ +IFN $$HST3,HRROI 2,[ASCIZ "SYSTEM:HOSTS3.BIN"] +.ELSE HRROI 2,[ASCIZ "SYSTEM:HOSTS2.BIN"] +] ;20X +IFN 10X,[ +IFN $$HST3,HRROI 2,[ASCIZ "HOSTS3.BIN"] +.ELSE HRROI 2,[ASCIZ "HOSTS2.BIN"] +] ;10X + GTJFN + JRST HSTMP7 ; Failed, restore regs. + MOVEM 1,HSTJFN + MOVE 2,[70000,,OF%RD] + OPENF + JRST [MOVE 1,HSTJFN + RLJFN + NOP + JRST HSTMP7] + MOVE 2,[1,,.FBBYV] + MOVEI 3,T + GTFDB ;XXX,,#PAGES + HRRZM T,HSTLEN + HRLZ 1,HSTJFN ;JFN,,FILE PAGE 0 + HRRZ 2,(P) ;PAGE NUMBER WITHIN US (saved on stack) + HRLI 2,.FHSLF + HRRZ 3,T + TLO 3,(PM%CNT\PM%RD) + PMAP +IFN 10X,[ + TRNE 3,-1 ; Counted out yet? + JRST [ HRRI 3,-1(3) ; Bump count down by 1 + TRNE 3,400000 ; and stop if done (count -1) + JRST .+1 + ADDI 1,1 ; Increment # of file page + AOJA 2,.-1] ; and # of process page... then repeat PMAP. +] ;10X + POP P,A + POP P,3 ? POP P,2 ? POP P,1 + MOVE T,A + IMULI T,1000 + MOVEM T,HSTADR +];TNX + MOVE T,HSTSID(T) ;CHECK THAT FIRST WORD OF FILE IS REALLY HOSTS3 +IFN $$HST3,CAME T,[SIXBIT /HOSTS3/] +.ELSE CAME T,[SIXBIT/HOSTS2/] + POPJ P, + JRST POPJ1 + +IFN TNX,[ +HSTMP7: POP P,A + POP P,3 ? POP P,2 ? POP P,1 + POPJ P, +] ;TNX + +; UNMAP HOSTS3. +HSTUNMAP: + SKIPN HSTADR + POPJ P, +IFN ITS,[ + MOVE T,HSTABN ; AOBJN PAGE POINTER TO HOSTS3 + SYSCAL CORBLK,[ 1000,,0 ; DELETE + 1000,,%JSELF ; FROM SELF + T ] + JFCL +];ITS +IFN TNX,[ + PUSH P,1 ? PUSH P,2 ? PUSH P,3 + SETO 1, + MOVE 2,HSTADR + IDIVI 2,1000 ;PAGE# + HRLI 2,.FHSLF + MOVE 3,HSTLEN + TLO 3,(PM%CNT) + PMAP +IFN 10X,[ + TRNE 3,-1 ; Counted out yet? + JRST [ HRRI 3,-1(3) ; Bump count down by 1 + TRNE 3,400000 ; and stop if done (count -1) + JRST .+1 + AOJA 2,.-1] ; Bump # of process page... then repeat PMAP. +] ;10X + POP P,3 ? POP P,2 ? POP P,1 +];TNX + SETZM HSTADR + JRST POPJ1 + +;Given host number in B, return its host name addr in rh(A) and set sign of A +;if the host is a Tip. Skip if successful. No skip => unknown host. +;We also return in D the address of the SITES table entry for the host. +HSTSRC: MOVE A,B + PUSHJ P,STDHST + MOVE B,A + SKIPN HSTADR ;Fail if the HOSTS3 file isn't loaded. + POPJ P, + PUSH P,C + PUSH P,E + PUSH P,T + GETNET C,B ; Get network number + MOVE D,HSTADR + ADD D,NETPTR(D) ;get address of NETWORKS table. + MOVE TT,0(D) ;get # of entries, + MOVE T,1(D) ;and entry size. + ADDI D,2 ;point at first entry. +HSTSR1: CAMN C,NETNUM(D) ;Find appropriate network + JRST HSTSR2 + ADD D,T + SOJG TT,HSTSR1 ;no => look at next entry. +HSTSRX: POP P,T ;unknown network => return non-skipping. + POP P,E + POP P,C + POPJ P, + +HSTSR2: HRRZ D,NTRTAB(D) ;Get address of ADDRESS table for that network + ADD D,HSTADR ;Binary-search it + MOVE C,1(D) ;Words per entry + MOVE E,0(D) ;Number of entries in table + MOVEI D,2(D) ;Base address of table + PUSH P,D +HSTSR3: CAIG E,1 + JRST HSTSR4 ;Search narrowed down to one location + MOVE T,E + LSH T,-1 + MOVE TT,T ;Number of entries in bottom "half" of table + IMUL T,C + ADD T,D ;Probe point + CAMGE B,ADDADR(T) + JRST [ MOVE E,TT ;Move down + JRST HSTSR3 ] + MOVE D,T ;Move up + SUB E,TT + JRST HSTSR3 + +HSTSR4: POP P,T ; Recover base addr of table + CAME B,ADDADR(D) ; Did we get any match at all? + JRST HSTSRX ; Nope, take non-skip return. +HSTSR5: SUBI D,(C) ; Found one! Back up to find 1st match + CAIGE D,(T) ; Make sure we don't back up past beg + JRST HSTSR6 + CAMN B,ADDADR(D) ; As long as we still get a match, + JRST HSTSR5 ; keep backing up. + +HSTSR6: ADDI D,(C) ; Recover from backup. + MOVEI E,(D) ; Save ptr to ADDRESS table + HLRZ D,ADLSIT(D) ; Get address of SITES table entry + ADD D,HSTADR + MOVE A,STLFLG ; Check flags + TLNE A,STFGWY ; to see if this one is a gateway. + JRST [ ADDI E,(C) ; Ugh, gateway. Try to skip it. + CAME B,ADDADR(E) + JRST .+1 ; No good, stuck with this one. + JRST HSTSR6] ; Hurray, try next entry! + HLRZ A,STLNAM(D) ;found the host => get the addr of its name + ADD A,HSTADR ;in our address space. + HLRZ C,STLSYS(D) + ADD C,HSTADR ;also get addr of its system type name + MOVE C,(C) + CAME C,[ASCIZ /TAC/] ;If it's a TAC, + CAMN C,[ASCIZ /TIP/] ; Or a TIP, + TLO A,400000 ; set sign bit of A. + AOS -3(P) ;Take skip return + JRST HSTSRX + +] ;END $$HSTMAP + +IFN $$NETSRC,[ +;;; NETSRC(B:net#) => A:name_p +;;; Convert a network number to a network name + +NETSRC: SKIPN HSTADR ;Fail if the HOSTS3 file isn't loaded. + POPJ P, + PUSH P,C + PUSH P,D + MOVE D,HSTADR + ADD D,NETPTR(D) ;get address of NETWORKS table. + MOVE TT,0(D) ;get # of entries, + MOVE T,1(D) ;and entry size. + ADDI D,2 ;point at first entry. +NETSR1: CAMN B,NETNUM(D) ;Find appropriate network + JRST NETSR2 + ADD D,T + SOJG TT,NETSR1 ;no => look at next entry. + POP P,D ;unknown network => return non-skipping. + POP P,C + POPJ P, + +NETSR2: HLRZ A,NTLNAM(D) ;Get address of name of network + ADD A,HSTADR + POP P,D ;unknown network => return non-skipping. + POP P,C + JRST POPJ1 + +];END $$NETSRC + +IFN $$SYMGET*$$HOSTNM,[ + +;Read in a host name. Works like SYMGET but searches host database. +;We return in A the number of the host, network# in TT. + +HOSTNM: ;Host name reader + PUSHJ P,HSTTBP ;E gets aobjn ptr to NAMES table, and set HSTNMF,NTSPCF + PUSHJ P,HSTNM1 ;Do an interactive symbol table lookup. + POPJ P, ;Failed + ;TT=0 => A has a number + ;else => A has file-relative address of SITE table entry + JUMPE TT,HOSTN1 + ;JRST HOSTN2 +];$$SYMGET*$$HOSTNM + +IFN <$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM>,[ +;Code to process result of Host-name lookup, returning full address in A +;with network number extracted into TT. +;Address was supplied, file-relative pointer to SITES table entry in A. +HOSTN2: ADD A,HSTADR + SKIPGE TT,NTSPCF ;Explicitly-specified network? + JRST HOSTN4 ;No, try all nets we know about +HOSTN3: HRRZ E,STRADR(A) ;Find an address for SITE in A on network in TT +HSTN3A: ADD E,HSTADR + GETNET T,ADDADR(E) + CAMN T,TT + JRST [ MOVE A,ADDADR(E) ;This is it + JRST POPJ1 ] + HRRZ E,ADRCDR(E) + JUMPN E,HSTN3A ;Try site's next address + POPJ P, ;Not found + +HOSTN4: ;Find a network address for this site +IFN $$CHAOS,[ ;Chaos net is preferred, try it first + MOVE TT,[NW%CHS] + PUSHJ P,HOSTN3 + CAIA + JRST POPJ1 +HOSTN5: +];$$CHAOS +IFN $$ARPA,[ + MOVE TT,[NW%ARP] + PUSHJ P,HOSTN3 + CAIA + JRST POPJ1 +HOSTN6: +];$$ARPA +IFE $$ALLNET,[ + POPJ P, ;Host exists, but not on any network we know about +]; $$ALLNET + +IFN $$ALLNET,[ + HRRZ E,STRADR(A) + JUMPE E,CPOPJ ;No addresses for this site? + ADD E,HSTADR ;where ADDRESS entry is in core + MOVE A,ADDADR(E) ;A J-random Host Address (some random net) + GETNET TT,A ; Extract the network number + JRST POPJ1 ;Success + +]; $$ALLNET + +;Number was supplied, it is in A. Determine what network it is on. +HOSTN1: +IFE $$ALLNET,[ + GETNET TT,A ;Maybe net was specified explicitly as part of number + JUMPN TT,[ ;Yes, make sure is on a network we know about + IRPS FLAG,,[$$CHAOS $$ARPA]NUM,,[NW%CHS NW%ARP] +IFN FLAG,[ CAMN TT,[NUM] + JRST POPJ1 +];FLAG + TERMIN + POPJ P, ] ;Can't find it +]; $$ALLNET + SKIPGE TT,NTSPCF ;Maybe network was specified by name + JRST [ PUSHJ P,STDHST ; Not specified, return standardized number. + JRST POPJ1] +IFN $$HST3, IOR A,TT +.ELSE DPB TT,[NW$BYT,,A] + JRST POPJ1 +];<$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM> + +IFN $$SYMLOOK*$$HOSTNM,[ + +;HSTLOOK takes args like SYMLOOK and looks in the HOSTS3 NAMES table. +;It returns the same things that HOSTNM returns. It clobbers E, T, TT. +;Also returns in B a pointer like SYMLOOK, or zero if no name lookup won. + +HSTLOOK: + PUSHJ P,HSTTBP ;E gets aobjn ptr to NAMES table, and set HSTNMF,NTSPCF + PUSHJ P,SYML1 ;Do a non-interactive symbol table search. + POPJ P, + MOVE A,T ;If the input was a number + AOJE B,HOSTN1 ;go canonicalize it + HLRZ A,NMLSIT-1(B) ;Else B points at a NAMES table word, so get + SOJA B,HOSTN2 ;the SITE table entry address, go find appropriate net address +];$$SYMLOOK*$$HOSTNM + +IFN <$$SYMGET\$$SYMLOOK>*$$HOSTNM,[ + +;Put in E an aobjn pointer to the HOSTS3 file's NAMES table. Also set HSTNMF. +HSTTBP: SKIPN E,HSTADR + NWLOSS + ADD E,NAMPTR(E) ;Address of NAMES table + MOVE T,1(E) ;Make sure words per entry is 1 + CAIE T,1 + NWLOSS + MOVN T,0(E) ;Negative number of entries + HRL E,T + ADDI E,2 ;E now has an aobjn pointer to the NAMES table. + SETOM HSTNMF ;Say that each address needs HSTADR added to it. + SETOM NTSPCF ;Say that no network explicitly specified + POPJ P, +];<$$SYMGET\$$SYMLOOK>*$$HOSTNM + +IFN $$SYMGET+$$ANALYZE,[ + +;TYPE A CRLF. CLOBBER T. +CRLF: MOVEI T,15 + PUSHJ P,PUTCHR + MOVEI T,12 + PUSHJ P,PUTCHR + POPJ P, + +;TYPE ASCIZ STRING POINTED TO BY TT, CLOBBER T. +ZTYPE: +IFN ITS,[ + HRLI TT,440700 +ZTYPE0: ILDB T,TT + JUMPE T,CPOPJ + PUSHJ P,PUTCHR + JRST ZTYPE0 +];ITS +IFN TNX,[ + PUSH P,1 + HRRO 1,TT + PSOUT + POP P,1 + RETURN +];TNX +];$$SYMGET+$$ANALYZE + +IFN $$HSTSIX,[ + +;Given a host number in A, returns a sixbit abbreviation of +;the name of the host, also in A. Clobbers only T and TT. +;You better call HSTMAP before this. +;Always skip returns. + +HSTSIX: PUSH P,B + PUSHJ P,STDHST + PUSH P,C + PUSH P,D + PUSH P,E + MOVE B,A + PUSHJ P,HSTSRC ;Find the SITES table entry for this host. + JRST HSTSX9 ;none => unknown host. Use HSTnnn. + SUB D,HSTADR ;D gets addr of SITES table entry relative to file + MOVE B,HSTADR ;(for comparison with LH's of NAMES table words). + ADD B,NAMPTR(B) ;Get address of NAMES table. + MOVE T,1(B) ;Make sure 1 word per entry + CAIE T,1 + NWLOSS + MOVE T,0(B) ;T gets number of entries in the table. + SETOB C,E ;E will get the address of the + ; longest name shorter than 7 chars, C its length. + HRRZ TT,A ;Check out the official name first + AOJA B,HSTSX0 + +HSTSX1: ADDI B,1 ;B points at next untried NAMES table entry. + HLRZ TT,NMLSIT(B) + CAME TT,D ;Does this name name the host we are serving? + JRST HSTSX4 + HRRZ TT,NMRNAM(B) ;If so, how long is this name? + ADD TT,HSTADR +HSTSX0: HRLI TT,440700 + PUSH P,TT + PUSH P,TT + SETZ A, +HSTSX2: ILDB TT,(P) + JUMPE TT,HSTSX3 + AOJA A,HSTSX2 + +HSTSX3: POP P,TT ;Flush garbage +IFN $$MIT,[ + MOVE TT,@(P) ;First word of name + TRZ TT,377 + CAMN TT,[ASCII/MIT-/] + CAIG A,6 ;Strip off "MIT-" if longer than 6 characters + JRST .+4 + SUBI A,4 + MOVSI TT,100700 + HLLM TT,(P) +];$$MIT + POP P,TT ;Restore pointer to name + CAIG A,6 ;Fit in 6 characters? + CAMG A,C ;and longer than the previous one? + JRST HSTSX4 + MOVE E,TT ;Yes, save its name's address. + MOVE C,A ;and the length of that one +HSTSX4: SOJG T,HSTSX1 ;look at all the names in the table. + AOJN E,HSTSX5 ;Jump if found a reasonable name + ADD D,HSTADR ;No short name, truncate official one + MOVEI C,"-" ;Also, will remove hyphens from it + HLRZ E,STLNAM(D) + ADD E,HSTADR ;Pointer to name +IFN $$MIT,[ + MOVE A,(E) + TRZ A,377 + CAMN A,[ASCII/MIT-/] + JRST [ HRLI E,100700 + AOJA E,HSTSX5 ] +];$$MIT + TLOA E,440700 +HSTSX5: SUBI E,1 + MOVE B,E ;Get BP to name string. +;B has a B.P. to the name string we are going to use. +;C has "- if we should remove all hyphens from it, otherwise C has a number from 1 to 6. +;Convert the name string to SIXBIT in A. + MOVE D,[440600,,A] + SETZ A, ;Convert name to SIXBIT word in A +HSTSX6: ILDB T,B + JUMPE T,HSTSX7 ;Stop if name string runs out (nice, it all fits). + CAMN T,C ;Remove hyphens if requested to + JRST HSTSX6 ;Note C has number from 1 to 6 or "- + SUBI T,40 + IDPB T,D + TLNE D,770000 ;Stop after getting one full word. + JRST HSTSX6 +HSTSX7: LDB T,D ;If last character is a hyphen, flush it. + CAIN T,'-' + MOVEI T,0 + DPB T,D +HSTSX8: POP P,E + POP P,D + POP P,C + POP P,B + JRST POPJ1 + +;Have to do it numerically. Depends on network. +HSTSX9: + MOVSI A,'NET' + GETNET TT,B + CAMN TT,[NW%CHS] + MOVSI A,'CHS' + CAMN TT,[NW%ARP] + JRST [ MOVSI A,'HST' +IFN $$HST3, LDB T,[002000,,B] ; IMP +.ELSE LDB T,[112000,,B] ;Imp + CAIGE T,100 + TRNN B,774 + JRST .+1 ;Doesn't fit in old-style +IFN $$HST3, LSH B,-16. + ANDI B,3 + LSH B,6 ;Host + DPB T,[000600,,B] ;Convert to old-style + JRST .+1 ] + HRRI A,'000' ;If host number less than 3 digits, pad with zeroes +IFE $$HST3, TLZ B,(.BM (NW$BYT)) ;Host number within network + SETZB T,TT ;T gets sixbit, TT gets char mask + PUSHJ P,HSTS9A + ANDCM A,TT ;Clear characters from A to be clobbered from T + IOR A,T ;Bring in number + JRST HSTSX8 + +HSTS9A: IDIVI B,8 + HRLM C,(P) + SKIPE B + PUSHJ P,HSTS9A + HLRZ C,(P) + LSH T,6 + IORI T,'0'(C) + LSH TT,6 + IORI TT,77 + POPJ P, +];$$HSTSIX + +;;; Standardize host number in A. Clobber T. +;;; No skip-return + +STDHST: +IFN $$HST3, JRST CVH3NA +.ELSE [ + TLNE A,777000 ;Network number specified? + JRST STDHS1 ;Yes, OK +IFN $$ARPA, TLO A,NW%ARP_9 ;No, default to some net we know about +.ELSE IFN $$CHAOS, TLO A,NW%CHS_9 +STDHS1: +IFN $$ARPA,[ + LDB T,[NW$BYT,,A] ;If Arpanet, standardize to new format + CAIN T,NW%ARP + TDNE A,[177777000] + POPJ P, + LDB T,[000600,,A] ;Imp + LDB A,[060200,,A] ;Host + DPB T,[112000,,A] + TLO A,NW%ARP_9 +];$$ARPA + POPJ P, +] ;HOSTS2 + +IFN $$OWNHST+<$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM>,[ +;;; GIVEN A NETWORK NUMBER IN A (WHICH MUST BE A NETWORK THIS PROGRAM IS +;;; CONDITIONALLY ASSEMBLED TO SUPPORT), RETURN THIS MACHINE'S OWN +;;; ADDRESS ON THAT NETWORK, IN A. CLOBBER T. SKIPS UNLESS HOST NOT ON THAT NET. +OWNHST: +IFN $$ARPA,[ + CAME A,[NW%ARP] + JRST OWNHS1 +IFN ITS,[ + SYSCAL NETHST,[MOVEI -1 ? MOVEM A ? MOVEM A] ;GET OWN ARPANET ADDRESS + POPJ P, ;MUST NOT BE ON ARPANET + PUSHJ P,STDHST ;SYSTEM DOESN'T RETURN NUMBER IN STANDARD FORMAT + JRST POPJ1 +];ITS +IFN TNX,[ + PUSH P,A + PUSH P,1 ? PUSH P,2 ? PUSH P,3 ? PUSH P,4 + MOVEI 1,.GTHSZ + GTHST + CAIA + AOS -5(P) ; Take skip return! + MOVEM 4,-4(P) ; Store result into what will be put in A + POP P,4 ? POP P,3 ? POP P,2 ? POP P,1 + POP P,A ;ALREADY IN INTERNET FORMAT +];TNX + +OWNHS1: +];$$ARPA + +IFN $$CHAOS,[ + CAME A,[NW%CHS] + JRST OWNHS2 +IFN ITS,[ + MOVE A,[SQUOZE 0,MYCHAD] + .EVAL A, + POPJ P, ;MUST NOT BE ON CHAOS NET +];ITS +IFN TNX,[ + PUSH P,A + PUSH P,1 ? PUSH P,2 + MOVE 1,[SIXBIT "CHSTAT"] + SYSGT + HRR 1,2 ;TABLE# + HRLI 1,2 ;WORD#2,,TABLE# + GETAB + JRST [POP P,2 ? POP P,1 + POP P,A ? POPJ P,] + MOVEM 1,-2(P) + POP P,2 ? POP P,1 + POP P,A +];TNX +IFN $$HST3, IOR A,[NW%CHS] +.ELSE TLO A,NW%CHS_9 + JRST POPJ1 +OWNHS2: +];$$CHAOS + POPJ P, ;Some network I don't know about +];$$OWNHST+<$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM> + +;;; Routine to compare two hosts +IFN $$HSTCMP,[ +;; Take host #'s in A and B, and skip if they refer to the same host. +;; Clobber no AC'S +;; +;;CALL: MOVE A,[HOST] +;; MOVE B,[HOST] +;; PUSHJ P,HSTCMP +;; different or error (unknown host or unmapped HOSTS3 table) +;; same + +HSTCMP: CAMN A,B ;Trivial case + JRST POPJ1 + PUSH P,A ;Clobber no AC's + PUSH P,B + PUSH P,T + PUSH P,D + PUSH P,D ;Get's SITE table entry + PUSHJ P,HSTSRC ;Check this one out + JRST HSTCM9 ; Non-existant or not mapped + MOVEM D,(P) ;Remember this site table entry + MOVE B,-4(P) ;Get the other host # + PUSHJ P,HSTSRC ;and look up it's SITE table entry + JRST HSTCM9 + MOVE T,(P) ;Recover the first SITE table entry + CAMN T,D ;Compare the two entry pointers + AOS -5(P) ; The same! +HSTCM9: POP P,D + POP P,D + POP P,T + POP P,B + POP P,A + POPJ P, + +];$$HSTCMP + +;;; Arpanet connection routines +IFN $$ARPA*ITS,[ +IFN $$ICP,[ + $$CONNECT==1 ;necessary subroutine + +; ARPA NETWORK ICP ROUTINE +; +;Call: MOVEI A,pin ;first of group of 3 channels to use (nonconsecutively numbered) +; ;PIN itself is used only for the ICP. PIN+1 is unused. +; ;PIN+2 and PIN+3 are the in and out sides of the TELNET connection. +; MOVEI B,host ;host number to connect to +; MOVEI C,frnsoc ;foreign socket number to icp through +; MOVE D,[imode,,omode] ;input and output modes as in OPEN on NET device. +; PUSHJ P,NETWRK"ARPICP ;do it. Clobbers A,B,C,D,E,T,TT. +; failed ;A holds the channel which lost. If $$ERRHAN, ANALYZ was called. +; succeeded + +ARPICP: MOVEI E,0 ;synchronous mode +ICPPHS: PUSHJ P,ICP1 ;This is also the phase table + PUSHJ P,ICP2 + PUSHJ P,ICP3 + JRST POPJ1 + +ICPASN: ;asynchronous mode. Same args except E is phase (initially 1). + SKIPL E ;keep calling back with same ACs as returned, until E is zero. + HRREI E,-3 ;asynchronous init + XCT ICPPHS+3(E) ;call appropriate phase + AOJA E,POPJ1 ;and advance to next + +;First phase - connect to ICP socket. +ICP1: PUSH P,D ;Assume that all sockets were closed, so ITS has deallocated any + SETZM SKTBAS ;old set of sockets, and we must ask it for a new set. + HRROI D,040044 ;asynchronous, 32-bit read + PUSHJ P,ARPCON ;initiate connection + JRST POP2J ;lose + POP P,D ;win + POPJ P, + +;Second phase - get server socket number and connect up. +ICP2: PUSHJ P,CONFIN ;finish ICP connection + JRST POP1J ;lose + SYSCAL IOT,[MOVEI (A) ? MOVEM C] ;get foreign socket number +IFE $$ERRHAN, JRST POP1J ;Connection opened but nothing came through, lose +.ELSE JRST [ POP P,C ? JRST ANALNS ] ;Analyze then take error return + ;Due to bug in NCP socket allocation, don't close contact pin yet + ADDI A,2 ;connect our read pin + ADDI C,1 ;to foreign write pin + PUSH P,D + HLROS D ;using input mode, asynchronously + PUSHJ P,ARPCON + JRST POP2J ;lose + ADDI A,1 ;connect our write pin + SUBI C,1 ;to foreign read pin + HRRO D,(P) ;using output mode, asynchronously + PUSHJ P,ARPCON + JRST POP2J ;lose + POP P,D + POPJ P, + +;Third phase - finish up connections. +ICP3: PUSHJ P,CONFIN ;finish write connection + JRST POP1J + SUBI A,1 + PUSHJ P,CONFIN ;finish read connection + JRST POP1J + SYSCAL CLOSE,[MOVEI -2(A)] ;and now close contact pin + .LOSE %LSSYS + POPJ P, + +] ;END IFN $$ICP + +IFN $$SERVE,[ + +;Call: MOVEI A,pin ;first channel number of three consecutive ones. +; ;the first is the ICP listen channel, +; ;the second is the input channel for the TELNET connection, +; ;the third is the output channel for it. +; MOVEI B,icpsoc ;socket to listen for an ICP on. +; MOVE C,[imode,,omode] ;input and output modes as in OPEN on NET device. +; PUSHJ P,NETWRK"ARPSRV ;Listen for and accept an ICP. +; timed out. +; succeeded. B has number of foreign host. +; +;If $$SYSDBG is 0, then connections from hosts locked out by SYSDBG are +;refused, and SERVE fails to skip. +;If $$SYSDBG is 1, then SERVE accepts all connections but returns in C +;a value which is nonzero if the foreign host ought to be locked out by SYSDBG. + +;Clobbers A, D, T and TT. + +$$CONNECT==1 ;We call ARPCON. + +ARPSRV: SYSCAL SSTATU,[MOVEM TT ? MOVEM SYSDBG'] + .LOSE %LSSYS + MOVEI TT,377777 ;If debugging, wait forever. + SKIPN DEBUG + MOVEI TT,30.*60. ;Otherwise time out after 60 sec. +ARPSR1: SYSCAL OPEN,[ A ? 5000,,40065 ? [SIXBIT/NET/] ? B] + JRST ARSVLS ;Open a channel to receive the RFC with. + SYSCAL WHYINT,[ A ? 2000,,T ? 2000,,T] + JRST ARSVLS +ARPSR2: CAIN T,%NSRFC ;Have we an RFC to accept? + JRST ARPSR3 + SKIPN DEBUG ;No => OK only if debugging + POPJ P, ;(so you can start your server before starting the user). + .CALL CONFIC ;So wait for it to change state and look again. + JRST ARSVLS ;[They also serve who hang and wait] + JRST ARPSR2 ;TRY AGAIN + +ARPSR3: HLRZ D,C + TLO D,400000 ;D gets mode for our input socket. + PUSH P,C + SYSCAL RCHST,[ A ? 2000,,C ? 2000,,C ? 2000,,C ? 2000,,B] + .LOSE %LSFIL ;C gets foreign socket ICP'd with. + ;B now has host number of host that ICP'd to us. + TLZ B,777000 ;Make sure network number field is 0 +IFE $$SYSDBG,[ + SKIPL T,SYSDBG ;If system being debugged, may refuse ICP + JRST ARPSR4 + ASH T,-9 ;Set to -1000*host# allowed in + ADD T,B ;Zero if this guy allowed in + JUMPN T,ARSVL2 +ARPSR4: ];$$SYSDBG +;remember that TT has the "sleep time" arguments for NETBLKs, including CONFI1. + SYSCAL NETAC,A + JRST ARSVL1 + ADDI A,1 ;Channel to make input connection on. + ADDI C,3 ;Foreign socket ICP'd with, plus 3, is target for our input. + SETZM SKTBAS' + PUSH P,TT ;See comment 6 lines above! + PUSHJ P,ARPCON + JRST [ POP P,TT ? JRST ARSVL1 ] + MOVE TT,SKTBAS ;Get socket number of our input connection + ADD TT,A + SYSCAL IOT,[1000,,-1(A) ? TT] + .LOSE %LSFIL ;Send our lower socket # to the ICPer. + SYSCAL CLOSE,[1000,,-1(A)] ;Don't need ICP socket any more. + .LOSE %LSFIL + HRRZ D,-1(P) ;Saved C + HRLI D,400000 + ADDI A,1 ;Now open our output connection + SUBI C,1 ;to a foreign socket 1 smaller than that used for our input. + PUSHJ P,ARPCON + JRST [ POP P,TT ? JRST ARSVL1 ] + POP P,TT + POP P,C + PUSHJ P,CONFI1 ;Then wait for the two connections to be finished. + JRST ARSVLS ;TT still has the time period (or by now maybe the + SUBI A,1 ;time to wait until). + PUSHJ P,CONFI1 + JRST ARSVLS +IFN $$SYSDBG,[ + SKIPL C,SYSDBG ;If system being debugged, may disallow + JRST [ SETZ C, ? JRST ARPSR5 ] + ASH C,-9 ;Set to -1000*host# allowed in + TLZ B,777000 ;Clear network number from host number + ADD C,B ;Zero if this guy allowed in +ARPSR5: ];$$SYSDBG + EXCH A,B ;Fix host# returned in B + PUSHJ P,STDHST + EXCH A,B + JRST POPJ1 + +ARSVL2: SYSCAL CLOSE,A + .LOSE %LSFIL +ARSVL1: POP P,C +ARSVLS: SKIPE DEBUG + NWLOSS + POPJ P, + +] ;END IFN $$SERVE + +IFN $$CONNECT,[ + +.SCALAR SKTBAS ; ne 0 => socket number of pin zero + +; ARPA NETWORK CONNECT ROUTINE +; +;Call: MOVEI A,pin ;local its chnl and relative socket number to connect +; MOVE B,host ;host number to connect to +; MOVEI C,frnsoc ;foreign socket number to connect to +; MOVEI D,mode ;mode to open in (RH). Bit 4.9=1 => asynchronous +; PUSHJ P,NETWRK"ARPCON +; lossage ;you may call ANALYZE to get an error message. +; ;If $$ERRHAN is nonzero, we call ANALYZE for you. +; +;Clobbers only T and TT. If using asynchronous mode, +;call CONFIN later (with pin number in A) to finish up. +; +; NOTE: AT PRESENT YOU MUST CONNECT THE LOWEST NUMBERED +; PIN FIRST, DUE TO BUGS IN SOCKET-SET ASSIGNMENT IN NCP. + +ARPCON: MOVE T,A ;Open operand word + HRL T,D ;is mode,,channel + SKIPN TT,SKTBAS ;get base of local socket group + TLO T,10 ;not yet allocated, use gensoc mode + ADD TT,A ;get local sock number to be opened +; TLZ B,777000 ;*** TEMPORARILY CLEAR NETWORK NUMBER UNTIL ITS IS FIXED *** + MOVEM B,ARPHST ;Save last Arpanet host hacked for ANALYZE + .CALL [ SETZ ;open 'er up + SIXBIT/OPEN/ + T ;mode,,channel + ['NET',,] ;arpanet device + TT ;local socket + C ;foreign socket + SETZ B ] ;foreign host +IFN $$ERRHAN,JRST ANALNS +.ELSE POPJ P, + SKIPE SKTBAS + JRST CONNE0 + SYSCAL RCHST,[A ? MOVEM T ? MOVEM T] ;Get local socket, from first pin + .LOSE %LSSYS + SUB T,A ;get socket base + MOVEM T,SKTBAS +CONNE0: JUMPL D,POPJ1 ;asynchronous, return now + ;otherwise, drop into CONFIN + +;Call: MOVEI A,pin ;pin number of connection +; MOVEI D,flags ;20 if listening, 0 if not. Left over from call to ARPCON. +; PUSHJ P,CONFIN ;finish connection +; lossage - you may call ANALYZE to get an error message +; win - clobbers only T and TT + +CONFIN: MOVEI TT,30.*60. ;wait at most one minute + SKIPE DEBUG ;In debug mode, wait forever + MOVSI TT,177777 +CONFI1: MOVEI T,%NSRFS ;Which state we started out in depends + TRNE D,20 ;on whether we were listening or initiating. + MOVEI T,%NSLSN + .CALL CONFIC ;Wait up to time in TT to leave state in T. + .LOSE %LSSYS + CAIE T,%NSOPN ;check good state + CAIN T,%NSINP + JRST POPJ1 + CAIE T,%NSRFC + CAIN T,%NSCLI + JRST POPJ1 +IFN $$ERRHAN,JRST ANALNS ;losing state +.ELSE POPJ P, + +CONFIC: SETZ ;wait for connection to open up + 'NETBLK' + A + T ;wait until not in state in T + TT + SETZM T ;return state + +];$$CONNECT +];$$ARPA*ITS +IFN $$ERRHAN,[ +ANALNS: PUSH P,B ;ANALYZE AND THEN POPJ + PUSH P,C + JRST ANALN1 +] ;END IFN $$ERRHAN + +;;; Chaos network connection routines +IFN $$CHAOS,[ +IFN ITS,[ +IFN $$SERVE,[ + +;Call: MOVEI A,chnl ;Input channel number. That+1 is output channel. +; MOVEI C,contact name ;an ASCIZ string +; MOVEI D,window size +; PUSHJ P,NETWRK"CHASRV +; lossage ;you may call ANALYZE to get an error message. +; ;If $$ERRHAN is nonzero, we call ANALYZE for you. +; +;Returns in B the number of the foreign host. +; +;If $$SYSDBG is 0, then connections from all hosts are +;refused, and SERVE fails to skip. +;If $$SYSDBG is 1, then SERVE accepts all connections but returns in C +;a value which is nonzero if the foreign host ought to be locked out by SYSDBG. + +;Clobbers A, D, T and TT. + +$$CONNECT==1 ;We call CHALSN. + +CHASRV: SYSCAL SSTATU,[MOVEM TT ? MOVEM SYSDBG'] + .LOSE %LSSYS + MOVEI TT,%COLSN + PUSHJ P,CHACN0 ;Start things up + POPJ P, ;Lost +;Listen done. Check host number, return OPN or CLS + CAIE TT,%CSRFC ;Have we an RFC to accept? + POPJ P, ;No, something went wrong + SYSCAL PKTIOT,[MOVEI (A) ? MOVEI PKTBUF] ;Get the RFC packet + .LOSE %LSSYS + LDB B,[$CPKSA+PKTBUF] ;Get source host +IFN $$HST3,IOR B,[NW%CHS] +.ELSE TLO B,NW%CHS_9 ;Including network number +IFE $$SYSDBG,[ ;Reject rfc if system down + SKIPL SYSDBG + JRST CHASV1 + MOVEI T,%COCLS ;Return CLS + DPB T,[$CPKOP+PKTBUF] + PUSH P,C + MOVEI C,[ASCIZ/System not up/] + PUSHJ P,CHSTNG + POP P,C + SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF] + .LOSE %LSSYS + JRST CHASRV ;Try again + +CHASV1: ];$$SYSDBG + MOVEI T,%COOPN ;Return Open + DPB T,[$CPKOP+PKTBUF] + SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF] + .LOSE %LSSYS +IFN $$SYSDBG,[ + SKIPL C,SYSDBG ;If system being debugged, may disallow + JRST [ SETZ C, ? JRST POPJ1 ] + ;Unlike Arpanet, we don't have selective disallow, just disallow everyone +];$$SYSDBG + JRST POPJ1 +] ;END IFN $$SERVE +];ITS +IFN TNX,[ +];TNX + +IFN $$CONNECT,[ +IFN ITS,[ +;CHAOS NETWORK CONNECT ROUTINE +; +;Call: MOVEI A,chnl ;Input channel number. That+1 is output channel. +; MOVEI B,host ;host number to connect to +; MOVEI C,contact name ;an ASCIZ string +; MOVEI D,window size +; PUSHJ P,NETWRK"CHACON +; lossage ;you may call ANALYZE to get an error message. +; ;If $$ERRHAN is nonzero, we call ANALYZE for you. +; +;Clobbers only T and TT. +; +;CHALSN is the same as CHACON except that it uses LSN instead of RFC. +; B is host number it must be from, or 0 if any host is acceptable. + +.VECTOR PKTBUF(%CPMXW) ;Buffer used by Open, Close, and Analyze + +CHACON: +$$LOG, LOG CHACON,[B,C] + MOVEI TT,%CORFC + PUSHJ P,CHACN0 ;Start things up + POPJ P, ;Lost + CAIE TT,%CSOPN + JRST CHACNL ;Started but didn't get open + JRST POPJ1 ;CHACON done + +CHACN0: SETZM PKTBUF + MOVE T,[PKTBUF,,PKTBUF+1] + BLT T,PKTBUF+%CPMXW-1 ;For extra luck, clear the packet buffer + DPB B,[$CPKDA+PKTBUF] ;Destination host + DPB TT,[$CPKOP+PKTBUF] + PUSHJ P,CHSTNG ;Store string from C + SYSCAL CHAOSO,[MOVEI (A) ? MOVEI 1(A) ? D] ;Assign Chaos index + JRST CHACNL + SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF] ;Send RFC or LSN + .LOSE %LSFIL + MOVEI TT,$$CHATO ;15-second timeout + SKIPE DEBUG + MOVSI TT,177777 ;Or infinite, in debug mode + LDB T,[$CPKOP+PKTBUF] + CAIE T,%COLSN ;Get the boring state + SKIPA T,[%CSRFS] + MOVEI T,%CSLSN + SYSCAL NETBLK,[MOVEI 1(A) ? T ? TT ? MOVEM TT] ;Await completion of connection + JRST CHACNL + JRST POPJ1 ;Return to second half + +CHALSN: MOVEI TT,%COLSN + PUSHJ P,CHACN0 ;Start things up + POPJ P, ;Lost +;Listen done. Check host number, return OPN or CLS + CAIE TT,%CSRFC ;Should be RFC into LSN + JRST CHACNL + SYSCAL PKTIOT,[MOVEI (A) ? MOVEI PKTBUF] ;Get the RFC packet + .LOSE %LSFIL + LDB T,[$CPKSA+PKTBUF] ;Check source host + CAIE T,(B) ;Not looking at network number + JUMPN B,CHALS2 ;Jump if doesn't match + MOVEI T,%COOPN ;Matches or we don't care, return open + DPB T,[$CPKOP+PKTBUF] + SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF] + .LOSE %LSFIL + JRST POPJ1 + +CHALS2: MOVEI T,%COCLS ;Return CLS + DPB T,[$CPKOP+PKTBUF] + PUSH P,C + MOVEI C,[ASCIZ/You are the wrong host./] + PUSHJ P,CHSTNG + POP P,C + SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF] + .LOSE %LSFIL + JRST CHALSN ;Try again + +CHACNL: ;CHACON or CHALSN lost +IFN $$ERRHAN, JRST ANALNS +.ELSE POPJ P, + +;Store string from C into PKTBUF. Bash T, TT +CHSTNG: PUSH P,B + PUSH P,C + MOVE B,[440800,,PKTBUF+%CPKDT] + MOVEI TT,0 + HRLI C,440700 +CHSTG1: ILDB T,C + JUMPE T,CHSTG2 + IDPB T,B + CAIGE TT,%CPMXC-1 + AOJA TT,CHSTG1 +CHSTG2: DPB TT,[$CPKNB+PKTBUF] + POP P,C + POP P,B + POPJ P, +] ;END IFN $$CONNECT +];ITS +IFN TNX,[ +];TNX + +IFN $$SIMPLE,[ +IFN ITS,[ +; CHASMP +; A - channel pair +; B - foreign host +; C - pointer to asciz string of contact name and arguments (if any) +; D - aobjn pointer to buffer in which answer is returned as asciz string +; Returns: +; non-skip failed to get response, or error response (you can call ANALYZE) +; skip once CLS response, asciz string in D's buffer +; skip twice ANS response, asciz string in D's buffer + +CHASMP: PUSH P,D + MOVEI D,5 ;Meaningless window size + MOVEI TT,%CORFC + PUSHJ P,CHACN0 ;Start things up + JRST CHASM9 ;Lose + CAIN TT,%CSCLS + SYSCAL PKTIOT,[MOVEI (A) ? MOVEI PKTBUF] ;Get the ANS/CLS packet + JRST CHASM9 ;Didn't get proper response + LDB TT,[$CPKOP+PKTBUF] + CAIN TT,%COANS + AOSA -1(P) ;Skip twice + CAIN TT,%COCLS + AOSA -1(P) ;Skip once + JRST CHASM9 ;Skip no times (shouldn't get here usually) + PUSH P,C + HLRE C,-1(P) ;Get minus number of words + IMUL C,[-5] + SUBI C,1 ;Number of characters not counting terminator + MOVE D,-1(P) + HRLI D,440700 + MOVE TT,[440800,,PKTBUF+%CPKDT] + LDB T,[$CPKNB+PKTBUF] + CAMGE T,C + MOVE C,T +CHASM1: ILDB T,TT + IDPB T,D + SOJG C,CHASM1 + IDPB C,D + POP P,C +CHASM9: POP P,D + POPJ P, +] ;END IFN $$SIMPLE +];ITS +IFN TNX,[ +];TNX +] ;END IFN $$CHAOS + +IFN $$TCP,[ +IFN $$SERVE,[ + +;Call: MOVEI A,chnl ;Input channel number. That+1 is output channel. +; MOVEI B,port# +; PUSHJ P,NETWRK"TCPSRV +; lossage ;you may call ANALYZE to get an error message. +; ;If $$ERRHAN is nonzero, we call ANALYZE for you. +; +;Returns in B the number of the foreign host. +; +;If $$SYSDBG is 0, then connections from all hosts are +;refused, and SERVE fails to skip. +;If $$SYSDBG is 1, then SERVE accepts all connections but returns in C +;a value which is nonzero if the foreign host ought to be locked out by SYSDBG. + +;Clobbers A, D, T and TT. + +$$CONNECT==1 ;just for TCPCNL + +TCPSRV: SYSCAL SSTATU,[MOVEM TT ? MOVEM SYSDBG'] + .LOSE %LSSYS + SYSCAL TCPOPN,[MOVEI (A) ? MOVEI 1(A) ? B + [-1] ? [-1]] ; Wild fgn port and host. + JRST TCPCNL ; Bah, failed for some reason. + MOVEI TT,$$TCPTO ;15-second timeout + SKIPE DEBUG + MOVSI TT,177777 ;Or infinite, in debug mode + MOVEI T,%NSLSN ; Initial state to hang on. +TCPSV1: SYSCAL NETBLK,[MOVEI 1(A) ? T ? TT ? MOVEM T ? MOVEM TT] + .LOSE %LSSYS ; Gack? + JUMPLE TT,TCPCNL ; Exit if timed out + CAIN T,%NSRFC ; If in SYN-RECEIVED state + JRST TCPSV1 ; then it's OK to keep waiting. + CAIE T,%NSOPN ; Else should be open now. + CAIN T,%NSRFN + CAIA + JRST TCPCNL ; Aw, phooie. + + ; TCP connection open now. + SYSCAL RFNAME,[MOVEI 1(A) ? MOVEM T + MOVEM T ; Local port # (should be = ICPSOC) + MOVEM T ; Foreign port # + MOVEM B]; Foreign host # + .LOSE %LSSYS ; Gack? +IFE $$SYSDBG,[ ;Reject rfc if system down + SKIPL SYSDBG + JRST TCPSV2 + ;I don't know how to do this right. Just send string and close + MOVE T,[440700,,[ASCIZ/System not up/]] + MOVEI TT,13. + SYSCAL SIOT,[MOVEI 1(A) ? T ? TT] + JFCL + SYSCAL CLOSE,[MOVEI (A)] + .LOSE %LSSYS + SYSCAL CLOSE,[MOVEI 1(A)] + .LOSE %LSSYS + JRST TCPSRV ;Try again + +TCPSV2: ];$$SYSDBG +IFN $$SYSDBG,[ + SKIPL C,SYSDBG ;If system being debugged, may disallow + JRST [ SETZ C, ? JRST POPJ1 ] + ;Unlike Arpanet, we don't have selective disallow, just disallow everyone +];$$SYSDBG + JRST POPJ1 +] ;END IFN $$SERVE + +IFN $$CONNECT,[ + +;TCP CONNECT ROUTINE +; +;Call: MOVEI A,chnl ;Input channel number. That+1 is output channel. +; MOVEI B,host ;host number to connect to +; MOVEI C,foreign port ;you don't get to pick the local port +; PUSHJ P,NETWRK"TCPCON +; lossage ;you may call ANALYZE to get an error message. +; ;If $$ERRHAN is nonzero, we call ANALYZE for you. +; +;Clobbers only T and TT. + +TCPCON: +$$LOG, LOG TCPCON,[B,C] + MOVEI T,1(A) ;Output channel + .CALL [ SETZ ? 'TCPOPN' ? A ? T ? [-1] ? C ? SETZ B ] + JRST TCPCNL ;Didn't even start trying + MOVEI TT,$$TCPTO ;15-second timeout + SKIPE DEBUG + MOVSI TT,177777 ;Or infinite, in debug mode + .CALL [ SETZ ? 'NETBLK' ? MOVEI 1(A) ? MOVEI %NSRFS ? TT + SETZM T ] ;T gets state it went into + .LOSE %LSSYS + CAIE T,%NSOPN ;Good state? + CAIN T,%NSRFN + JRST POPJ1 ;Success +TCPCNL: ;Timed out or failed +IFN $$ERRHAN, JRST ANALNS +.ELSE POPJ P, +];$$CONNECT +];$$TCP + +IFN $$ANALYZE*ITS,[ + +; Network error analysis. + +;Call: MOVEI A,pin ;channel number that is losing +; PUSHJ P,ANALYZE +; .VALUE ;always skip-returns +; +;Clobbers only T and TT. Uses the PUTCHR routine to type out its messages. +;Does not type a crlf after the message. + +.VECTOR WHYINT(5) ;Cruft returned from WHYINT + +ANALYZE: + AOS (P) + PUSH P,B + PUSH P,C +ANALN1: SYSCAL USRVAR,[MOVEI %JSELF ? MOVEI .RIOC(A) ? MOVEM T ] ;Channel open? + .LOSE %LSSYS + JUMPE T,ANALN2 ;No, don't clobber error code with WHYINT + SYSCAL WHYINT,[A ? MOVEM WHYINT ;Get device type + MOVEM WHYINT+1 ? MOVEM WHYINT+2 ? MOVEM WHYINT+3 + MOVEM WHYINT+4 ] + .LOSE %LSFIL + MOVE T,WHYINT ; Get device type +IFN $$TCP\$$ARPA,[ + CAIE T,%WYNET + CAIN T,%WYTCP + JRST ANAL1 ; Go analyze NCP/TCP channel. +];$$TCP\$$ARPA +IFN $$CHAOS,[ + CAIN T,%WYCHA + JRST ANLCHA ;Chaos net channel open, further info available +];$$CHAOS +ANALN2: SYSCAL USRVAR,[MOVEI %JSELF ? MOVEI .RIOS(A) ? MOVEM T] ;Get I/O status wd for channel + .LOSE %LSSYS + LDB TT,[220600,,T] ;only the open-loss code is available + CAIN TT,%EFLDV ;Device full (this one applies to both Arpanet & Chaos net) + JRST [ JSP TT,SPEAK + ASCIZ \All sockets in use.\ ] + CAIN TT,%ENRDV ;Device not ready + JRST [ JSP TT,SPEAK + ASCIZ \Network down.\ ] +IFN $$ARPA,[ + CAIE TT,%ENAPP ;Other end of pipeline gone, or + CAIN TT,%ENSDR ;No such directory + JRST [ ;Host is down, say why. + MOVE T,ARPHST ;Go print status for last host hacked, is probably right one + JRST ANALC1 ] ;Unfortunately, channel not open, can't get right host + CAIN TT,%ESCO ;Self-contradictory open + JRST [ JSP TT,SPEAK + ASCIZ \Connection cannot be opened because of inconsistent byte sizes.\ ] +];$$ARPA + SYSCAL IOPUSH,[A] ;Some other error - get ITS error message + .LOSE %LSSYS + .CALL [ SETZ + SIXBIT/OPEN/ + MOVEI (A) ;here we rely on .UAI=0 + ['ERR',,] + MOVEI 3 ;Status from T + SETZ T ] + .LOSE %LSFIL + MOVEI TT,[ASCIZ\? Internal error - \] + PUSHJ P,ZTYPE +ANAL0: SYSCAL IOT,[MOVEI (A) ? MOVEM T] ;copy error message to output device + .LOSE %LSSYS + CAIGE T,40 + JRST ANALYX + PUSHJ P,PUTCHR + JRST ANAL0 + +ANALYX: SYSCAL IOPOP,[A] + .LOSE %LSSYS +ANALX: POP P,C + POP P,B + POPJ P, + +IFN $$TCP\$$ARPA,[ +; Arpanet channel still open - further information available + +ANAL1: HRRZ TT,WHYINT+1 ;get socket state + JUMPE TT,ANALC .SEE %NSCLS ;connection closed +IFN $$TCP,[ + CAIN T,%WYTCP + JRST ANAL20 ; Report TCP channel state +] ;$$TCP + CAIN TT,%NSRFS ;state is %NSRFS => we must have timed out at CONFIN. + JRST [ JSP TT,SPEAK + ASCIZ /Timed-out while awaiting response to opening of connection./ ] + CAIN TT,%NSLSN ;same but listening rather than rfc'ing + JRST [ JSP TT,SPEAK + ASCIZ/Timed-out while listening for request to open connection./ ] + JRST ANAL50 ; Give up, complain about illegal state + +IFN $$TCP,[ +ANAL20: CAILE TT,%NTINP + JRST ANAL50 ; State too big + PUSH P,TCPSTB(TT) ; Get state message + MOVEI TT,[ASCIZ /Connection /] + PUSHJ P,ZTYPE + POP P,TT + JRST SPEAK + +TCPSTB: OFFSET -. +%NTCLS:: [ASCIZ /closed./] +%NTLSN:: [ASCIZ /listening./] +%NTSYR:: [ASCIZ /wedged, SYN rcvd but not acked./] +%NTCLU:: [ASCIZ /being closed by foreign host./] +%NTSYN:: [ASCIZ /waiting for response to SYN./] +%NTOPN:: [ASCIZ /open./] +%NTWRT:: [ASCIZ /open, output buffer full./] +%NTCLX:: [ASCIZ /being closed by user./] +%NTCLI:: [ASCIZ /closed, input still available./] +%NTINP:: [ASCIZ /open, input available./] + OFFSET 0 +] ;$$TCP +ANAL50: PUSH P,TT + MOVEI TT,[ASCIZ\? Socket entered illegal state #\] + PUSHJ P,ZTYPE + LDB T,[030300,,(P)] + SKIPE T + PUSHJ P,[ ADDI T,"0" ? JRST PUTCHR ] + POP P,T + ANDI T,7 + ADDI T,"0" + PUSHJ P,PUTCHR + JRST ANALX +];$$TCP\$$ARPA + +SPEAK: PUSHJ P,ZTYPE ;send message from TT + JRST ANALX ; and return + +IFN $$TCP\$$ARPA,[ + +;Say why connection was closed +ANALC: SYSCAL RFNAME,[MOVEI (A) ? MOVEM T + MOVEM T ? MOVEM T ; Local port, fgn port + MOVEM T ] ; Fgn host (NCP: 1.1-1.9) + .LOSE %LSSYS + HRRZ TT,WHYINT+3 ; Get close reason + CAIL TT,LCLSTB + SETO TT, + MOVE TT,CLSTAB(TT) ;get asciz close reason + PUSH P,T ;save host number + PUSH P,TT + PUSHJ P,ZTYPE + POP P,TT + POP P,T + JUMPGE TT,ANALX ;return if host is up + MOVE TT,WHYINT + CAIN TT,%WYTCP ; If TCP, must do further checking + JRST [ GETNET TT,T ; Get network number + CAME TT,[NW%ARP] ; Can only get status for arpanet sites + JRST ANALX ; Sorry, no can do. + JRST .+1] ; Aha, try NETHST call. + + PUSHJ P,CRLF ;CRLF between down message and down reason +ANALC1: SYSCAL NETHST,[T ? MOVEM T] ;get information about why host down + .LOSE %LSSYS + MOVE B,T + TRZ T,777760 ;RH gets just reason down + TLNE T,2000 ;skip if down + SETO T, + MOVE TT,DEDTAB(T) ;get asciz string describing situation + PUSHJ P,ZTYPE +IFE $$UPTM,JRST ANALX +IFN $$UPTM,JRST ANALTM + +IFN $$UPTM,[ + +;OPTIONALLY, SAY WHEN THE IMP THINKS THE HOST WILL BE BACK UP. +ANALTM: ANDI B,177760 ; get time back + JUMPE B,ANALX ; flush if nothing + CAIN B,177740 ; -2 means unknown future time + JRST ANALX ; There isn't anything useful to say about this. + MOVEI TT,[ASCIZ / Host is expected back up /] + PUSHJ P,ZTYPE + CAIN B,177760 ; -1 means more than a week + JRST [ JSP TT,SPEAK + ASCIZ /over a week from now./ ] + LDB T,[150300,,B] ; get day of week + LDB TT,[100500,,B] ; get hours time + SUBI TT,5 ; EST/GMT offset + PUSH P,B + .RYEAR B, ; get time info + TLNE B,100000 ; daylight losing time? + AOSL TT ; yes, go ahead an hour + JUMPGE TT,NODAY ; easy way out + ADDI TT,24. ; move up a day + SOSGE T ; and days back + MOVEI T,6 ; back to Sunday +NODAY: MOVE B,TT ; Save real hours + MOVE TT,DOWTAB(T) ; Get string describing day of week. + PUSHJ P,ZTYPE + MOVEI TT,[ASCIZ / at /] + PUSHJ P,ZTYPE + MOVE T,B ; get hours time + PUSHJ P,2DTYPE + MOVEI T,":" + PUSHJ P,PUTCHR + POP P,B ; Restore original time + LDB T,[040400,,B] ; get minutes/5 + IMULI T,5. ; make into real minutes + PUSHJ P,2DTYPE + MOVEI TT,[ASCIZ/ EST./] + .RYEAR T, + TLNE T,100000 + MOVEI TT,[ASCIZ/ EDT./] + PUSHJ P,ZTYPE + JRST ANALX + +;TYPE NUMBER IN T AS TWO DECIMAL DIGITS. +2DTYPE: IDIVI T,10. ; split high and low order + ADDI T,"0" ; ASCIIify + ADDI TT,"0" ; ASCIIify + PUSH P,TT + PUSHJ P,PUTCHR + POP P,T + JRST PUTCHR + +DOWTAB: [ASCIZ/on Monday/] + [ASCIZ/on Tuesday/] + [ASCIZ/on Wednesday/] + [ASCIZ/on Thursday/] + [ASCIZ/on Friday/] + [ASCIZ/on Saturday/] + [ASCIZ/on Sunday/] + [ASCIZ/on April Fool's day/] + +] ;END IFN $$UPTM +];$$TCP\$$ARPA + +IFN $$CHAOS,[ +;Analyze on chaos channel, still open + +ANLCHA: MOVE TT,WHYINT+1 ;Connection state + CAIE TT,%CSLOS + CAIN TT,%CSCLS + JRST ANLCH1 + CAIE TT,%CSINC + JRST ANLCH0 ;Still open + JSP TT,SPEAK + ASCIZ /Connection broken -- foreign host not communicating./ + +ANLCH0: PUSH P,CHSTTB(TT) + MOVEI TT,[ASCIZ/Timed-out while connection /] + PUSHJ P,ZTYPE + POP P,TT + JRST SPEAK + +CHSTTB: [ASCIZ/closed/] + [ASCIZ/listening/] + [ASCIZ/has received RFC/] + [ASCIZ/trying to get connected/] ;has sent RFC + [ASCIZ/open/] + [ASCIZ/lost/] + [ASCIZ/broken/] + +ANLCH1: PUSH P,CHSTTB(TT) + MOVEI TT,[ASCIZ/Connection /] + PUSHJ P,ZTYPE + POP P,TT + PUSHJ P,ZTYPE + MOVEI TT,[ASCIZ/ -- /] + PUSHJ P,ZTYPE + HLRZ TT,WHYINT+2 ;get number of input packets +ANLCH2: SOJL TT,ANALX ;scan input looking for CLS, LOS + HLRZ T,WHYINT+4 ;Pick up input channel number + SYSCAL PKTIOT,[T ? MOVEI PKTBUF] + .LOSE %LSFIL + LDB T,[$CPKOP+PKTBUF] + CAIE T,%COCLS + CAIN T,%COLOS + SKIPA B,[440800,,PKTBUF+%CPKDT] + JRST ANLCH2 + LDB C,[$CPKNB+PKTBUF] +ANLCH3: SOJL C,ANALX + ILDB T,B + PUSHJ P,PUTCHR + JRST ANLCH3 +];$$CHAOS + +IFN $$ARPA\$$TCP,[ + +; Tables + +;Close Reasons + + [ASCIZ/Illegal close-reason code??/] +CLSTAB: OFFSET -. +%NCNTO::[ASCIZ/Connection never opened??/] +%NCUSR::[ASCIZ/Connection legitimately closed??/] +%NCFRN::[ASCIZ/Connection closed by foreign host./] +%NCRST::[ASCIZ/Connection reset by foreign host./] +%NCDED::400000,,[ASCIZ/Host died./] +%NCINC::400000,,[ASCIZ/Incomplete transmission - foreign host or network died./] +%NCBYT::[ASCIZ/Byte size mismatch??/] +%NCNCP::[ASCIZ/Local Network Control Program reset./] +%NCRFS::[ASCIZ/Request for Connection refused by foreign host./] +LCLSTB::OFFSET 0 + +;Host Dead Reasons + + [ASCIZ/Illegal host-dead code??/] +DEDTAB: [ASCIZ/ Network lossage./] ;0 probably no host-dead-reason returned + [ASCIZ/ Destination Host dead./] ;1 WOULDN'T SAY WHY + [ASCIZ/ Foreign Network Control Program not in operation./] + [ASCIZ/ Destination Host or IMP does not exist./] + [ASCIZ/ Destination Host is initializing its NCP software./] + [ASCIZ/ Destination Host down for scheduled maintenance./] + [ASCIZ/ Destination Host down for scheduled hardware work./] + [ASCIZ/ Destination Host down for scheduled software work./] + [ASCIZ/ Destination Host is in emergency restart./] + [ASCIZ/ Destination Host down due to power failure./] + [ASCIZ/ Destination Host is stopped at a breakpoint./] + [ASCIZ/ Destination Host down due to hardware failure./] + [ASCIZ/ Destination Host is not scheduled to be up./] + [ASCIZ/ (Undefined host-down code 13.)/] + [ASCIZ/ (Undefined host-down code 14.)/] + [ASCIZ/ Destination Host is coming up now./] + +];$$ARPA\$$TCP +];END IFN $$ANALYZE*ITS + +IFN $$CVH,[ +;;;; Utilities - CVH2NA, CVH3NA + +; CVH2NA - Convert network host address in A to HOSTS2 format. +; A/ net address (any format) +; Returns A + +CVH2NA: PUSH P,B + LDB B,[301400,,A] ; Get high 12 bits of net address + CAIGE B,70 ; If less than lowest HOSTS2-fmt value + JUMPN B,CVH2N3 ; then must be HOSTS3, go convert. + CAIL B,1000 ; If any of high 3 bits set, + JRST CVH2N3 ; then it's a HOSTS3 strange-fmt number. + JUMPN B,CVH2N2 + CAILE A,377 ; Zero network, so must be ARPA net + JRST CVH2N1 ; Not just 8 bits, just add net number. + + ; Old-style 8-bit Arpanet host number + LSHC A,-6. + ROT B,6. + DPB B,[112000,,A] +CVH2N1: TLO A,(12_33) + JRST CVH2N9 + + ; Probably HOSTS2 format number +CVH2N2: JRST CVH2N9 ; For now, that's good enough. + + ; HOSTS3 format number, convert it. +CVH2N3: CAIN B,12 ; Arpa net? + JRST [ LSHC A,-16. + ANDI A,377 + ROT B,16. + DPB B,[112000,,A] + TLO A,(12_33) + JRST CVH2N9] + CAIN B,7+ ; Chaos net? + JRST [ ANDI A,177777 ; Yup, fix it up. + TLO A,(7_33) + JRST CVH2N9] + CAIN B,22 ; LCS net? + JRST [ LSHC A,-8. + ANDI A,-1 + LSH A,2 + LSHC A,8. + TLO A,(22_33) + JRST CVH2N9] + + ; Not a known net, but try to do something plausible. + ANDCM A,[-1_24.] ; Preserve low 24 bits + DPB B,[331100,,A] ; put net # into HOSTS2 field. +CVH2N9: POP P,B + POPJ P, +] ;$$CVH + +; CVH3NA - Convert network host address in A to HOSTS3 (Internet) format. +; A/ net address (any format) +; Returns A + +CVH3NA: PUSH P,B + LDB B,[301400,,A] ; Get high 12 bits of net address + CAIGE B,70 ; If less than lowest HOSTS2 value, + JUMPN B,CVH3N3 ; it's already HOSTS3 format! (unless zero) + CAIL B,1000 ; If any of high 3 bits were set, + JRST CVH3N3 ; it must be a HOSTS3 strange-fmt addr. + JUMPN B,CVH3N2 ; If not zero, then must assume HOSTS2 fmt. + + ; Old-format 8-bit Arpanet host number, or HOSTS2 with zero net. +IFE $$ARPA,IFN $$CHAOS, IOR A,[NW%CHS] ? JRST CVH3N3 + CAILE A,377 + JRST CVH3N6 ; If greater than 8 bits, assume HOSTS2, zero net. + LSHC A,-6 ; Put 10 bits spacing between host/imp #s. + LSH B,-<2+8.> + LSHC A,<2+8.+6> + TLO A,(12_24.) ; and add ARPA network number. + JRST CVH3N3 + + ; HOSTS2 format number +CVH3N2: TRZE B,7 ; Zap low 3 bits to ensure correct comparison + JRST CVH3N5 ; If any were set, can't be Chaosnet. + CAIN B,7_3 ; Chaos net? + JRST [ ANDI A,177777 ; Yes, kill all but bottom 16 bits + TLO A,(NE%UNT+<7_24.>) ; Add Chaos net # + JRST CVH3N3] +CVH3N5: CAIN B,12_3 ; Arpa net? +CVH3N6: JRST [ LSHC A,-9. + ANDI A,177777 + ROT B,9. + DPB B,[201000,,A] + TLO A,(12_24.) + JRST CVH3N3] + CAIN B,22_3 ; LCS net? + JRST [ LSHC A,-8. + LSH A,-2 + ANDI A,377 + LSHC A,-8. + TLO A,(22_24.) + JRST CVH3N3] + + ; No match, assume it's HOSTS3. +CVH3N3: POP P,B + POPJ P, + + +$$LOG,[ +;;; Logging - CStacy, 22 October 1984 +;;; +;;; This facility is (originally) so that I can see which users are using +;;; the TELNET and FTP facilities on our machine and to help discover who +;;; is using us as a base in attacking other sites. Maybe ITS should do +;;; some sort of network logging like Multics, but I'll just put it in +;;; this library for now since it isn't clear how generally useful it is +;;; or what functionality we want. + +LOGO==1 ;Channel for log file. +LOGL==2 ;Channel for log file lock-file. + +;;; NOTE: The user could easily become screwed up if we're interrupted. +;;; --We have IOPUSHed channels away from the user without consent. +;;; --We do synchronous file IO behind its back and handle our own errors. +;;; Therefore, LOG processing defers all interrupts. +;;; The LOG stuff is only called before opening and after closing network +;;; channels, and so this should be a first approximation to a safe practice. + +;;; Logfile entries are scattered through the file in sequential order. +;;; They are of variable length. They begin with a unique id number; +;;; The log for a particular job can be threaded from the id. +;;; +;;; An transaction entry looks like: +;;; /BEGIN/ +;;; BEGIN-CODE (id) The 36 bit unique id code for this job. +;;; TIMESTAMP The time of the entry. +;;; OPCODE Sixbit name of the transaction type. +;;; CRUFT WORDS Transaction dependant data. +;;; +;;; +;;; The NETLOG program (source in AR2:CSTACY;NETLOG) can be used to +;;; expand a logfile into an ASCII representation of some or all of the +;;; transactions. +;;; +;;; It is possible to have incomplete records of network usage +;;; in the logfile, since if many things go wrong we abort the +;;; logging procedure rather than waste time being too robust +;;; when the entire facility is supposed to be invisible. + +;;; NETWRK routines may call LOGACT to log some action. +;;; Callers provide any list of cruft they want, the first word +;;; being SIXBIT name of the operation. +;;; Semantics for entries should be documented here for interested +;;; programmers to find out how to decode the log file. +;;; +;;; OPEN: +;;; ANALYZ: ... +;;; + +.SCALAR LOGID ;Our id number in the log file. + +;;; LOGACT - Log some action +;;; A/ number of crufty words on the stack (P) before the funcall. +;;; Smashes no ACs and never skips. +;;; Caller must pop his args back off himself. + +LOGACT: MOVE T,P ;Save current SP here for a moment. + .SUSET [.RPICLR,,TT] ;Read global interrupt defer word. + PUSH P,TT ;Stack it away for restoration. + .SUSET [.SPICLR,,[0]] ;Defer all interrupts. + .IOPUSH LOGO, ;Push the channels we want, + .IOPUSH LOGL, ;hoping the IOPDL doesn't overflow. + PUSH P,A ;Do not smash ACs. + PUSH P,B + PUSH P,C + PUSH P,D + MOVE B,T ;B gets SP to top of LOGACT frame. +LOGA10: PUSHJ P,LOGOPN ;Open log file if needed. + JRST LOGCLS + SYSCAL ACCESS,[%CLIMM,,LOGO ? C] ;Move to EOF. + JRST LOGCLS + SUB B,A ;Point to first arg. + HRLZ A,A + HRR A,B ;A has length,,adr of crufties. +LOGA20: SYSCAL RQDATE,[%CLOUT,,B] + JRST LOGCLS + SKIPE C,LOGID ;If our id has been initialized, + JRST LOGA30 ; go make an entry. + .SUSET [.RUIND,,C] ;Else find our job number. + HRL C,B ;*** This should be more or less unique? ** + MOVEM C,LOGID ;Set our id. +LOGA30: MOVE T,[444400,,[SIXBIT /BEGIN/]] + MOVEI TT,1 + SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT] ;Write entry marker. + JRST LOGCLS + MOVE T,[444400,,B] + MOVEI TT,2 + SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT] ;Write timestamp and id. + JRST LOGCLS + .SUSET [.RUNAME,,B] + .SUSET [.RJNAME,,C] + MOVE T,[444400,,B] + MOVEI TT,2 + SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT] ;UNAME, JNAME. + CAIA +LOGA40: HRRZ T,A ;Get ptr to stacked args. + HRLI T,444400 ;Make BP. + HLRZ TT,A ;Get length. + SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT] ;Write opcode, crufties. + JRST LOGCLS +LOGCLS: .CLOSE LOGO, + .CLOSE LOGL, + .IOPOP LOGL, + .IOPOP LOGO, + POP P,D + POP P,C + POP P,B + POP P,A + POP P,T ;Probably -1 (no global deferment). + .SUSET [.SPICLR,,T] ;Restore interrupt defer state. + POPJ P, ;All done. + + +;;; LOGOPN - Seize the logfile lock, and open the logfile for writing. +;;; Uses LOGL and LOGO file channels, and skips on success. +;;; Returns length of the database in C, does not smash other ACs. +;;; Notes: +;;; o If the lock file is missing LOGOPN will re-create it. +;;; o If the logfile itself is missing, we just fail. + +LOGMLT==6 ;Maximum # attempts to make trying to seize the lock. + +LOGOPN: PUSH P,A + PUSH P,B + SETZ B, ;Count of locking attempts in B. +LOGLOK: SYSCAL OPEN,[%CLBIT,,.BIO\%DOWOV ? %CLIMM,,LOGL + [SIXBIT /DSK/] + [SIXBIT /NETLOG/] + [SIXBIT /LOCK/] + [SIXBIT /SPACY/]] + CAIA + JRST LOGLKD ;Got it! + CAIL B,LOGMLT ;Else if we have exceeded the retry maximum + JRST LOGLKF ; Fail. + .STATUS LOGL,A ;Let's see why the open failed. + LDB A,[220600,,A] ;Get error code. + CAIN A,%ENAFL ;If someone else has the lock + JRST [ MOVEI T,30. ; Sleep for one second. + .SLEEP T, ; (They should give it up soon.) + AOS B ; Keep count of attempts to seize lock. + JRST LOGLOK ] ; Try,try again. + CAIE A,%ENSFL ;Hmmm....Maybe the lock file is missing? + JRST LOGLKF ; Nope - some random lossage. + SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,LOGL ;Re-create it. + [SIXBIT /DSK/] + [SIXBIT /NETLOG/] + [SIXBIT /LOCK/] + [SIXBIT /SPACY/]] + JRST LOGLKF ; Fail if could not create lock. + .CLOSE LOGL, ;Else close file + JRST LOGLOK ;and try to seize it again. +LOGLKD: SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,LOGO + [SIXBIT /DSK/] + [SIXBIT /NETLOG/] + [SIXBIT / DATA/] + [SIXBIT /SPACY/]] + JRST LOGLKF + SYSCAL FILLEN,[%CLIMM,,LOGO ? %CLOUT,,C] + JRST LOGLKF + .CLOSE LOGO, ;Protocol says no lock competition here. + SYSCAL OPEN,[%CLBIT,,%DOWOV+.UIO ? %CLIMM,,LOGO + [SIXBIT /DSK/] + [SIXBIT /NETLOG/] + [SIXBIT / DATA/] + [SIXBIT /SPACY/]] + CAIA ; Huh? We opened it a moment ago??? + AOS -2(P) ;Skip return if won. +LOGLKF: POP P,B + POP P,A + POPJ P, + + +];$$LOG + + +.qmtch=qmtch ;set this back to the value the user gave it + +.END NETWRK