diff --git a/Makefile b/Makefile index 4430fa56..c814332a 100644 --- a/Makefile +++ b/Makefile @@ -23,7 +23,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \ tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \ draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo \ - macsym lmcons dmcg hack hibou agb gt40 + macsym lmcons dmcg hack hibou agb gt40 rug DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ diff --git a/build/misc.tcl b/build/misc.tcl index 63b3868c..54508fa6 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -1136,6 +1136,12 @@ type ":vk\r" respond "*" ":palx cons;_lmcons;ccons\r" expect ":KILL" +# Logo RUG. STUFF prefers it to be RUG; AR BIN. +respond "*" ":palx rug;_ar\r" +# We'll just do the Logo PDP-11/45. +respond "COMPUTER=" "1\r" +expect ":KILL" + # 11BOOT respond "*" ":midas /t sys3;ts 11boot_syseng;11boot\r" respond "with ^C" "APR==0\r\003" diff --git a/doc/programs.md b/doc/programs.md index 0b1583ad..2803a227 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -12,6 +12,7 @@ - ADV350, 350-point Adventure. - ADV448, 448-point Adventure. - ANIMAL, an animal guessing game. +- AR, PDP-11 debugger. - ARCCPY, copies an old-format archive, converting to new format. - ARCDEV, transparent file system access to archive files. - ARCSAL, archive salvager. diff --git a/src/rug/ar.632 b/src/rug/ar.632 new file mode 100644 index 00000000..6e31b5f2 --- /dev/null +++ b/src/rug/ar.632 @@ -0,0 +1,6116 @@ +%ABSAD==1 +%COMPA==0 +;THIS IS THE WAY RUG LOOKS WHEN IT IS IN CORE (WHEN IT ISN'T CLOBBERED) + +;THE SYMBOL TABLE EXTENDS DOWN TOWARDS CSTBL +;IT MEETS RUGS SYMBOLS AT RUGFNT (WHERE RUG BEGINS) +;AND CONTINUES TO O.BSYM + +;RUGS STACK SITS ABOVE THAT FOLLOWED BY +;ITS COPY OF THE USERS REGISTERS AND +;THE BREAKPOINT TABLES + +;NOW COMES THE BODY OF RUG + +;THE CONSOLE PROGRAM AND ABSOLUTE LOADER ARE IN HERE SOMEWHERE + +;AND LAST OF ALL THE RESIDENT PORTION OF RUG SITS AT THE VERY TOP + ;DEFINE A BUNCH OF FLAGS + + + .IF1 + .MACRO SETF TEXT,FLG + .PRINT "TEXT +FLG'=" + .TTYMAC FLAG + FLG==FLAG + .ENDM + .ENDM + + SETF ^\0=>GUY45, 1=>LOGO45, 2=>TV20, 3=>FREDKIN 11/40, 4=>OTHER\,COMPUTER + .IFZ COMPUTER + .TITLE RUG FOR GUY'S LOGO 11/45 + TEN11==0 + FMH==1 + HCOR==160000 + CSTBL==30000 + F.HD==0 + DM11==0 + KL11==0 + M.HD==1 + FPTR==1 + M1145==1 + FPP==1 + DCSPD==11 + LINEAD==174000 + M1140==0 + M40FPU==0 + .ENDC + .IFZ COMPUTER-1 + .TITLE RUG FOR THE LOGO 11/45 + TEN11==1 + FMH==1 + HCOR==160000 + CSTBL==30000 + F.HD==0 + DM11==0 + KL11==0 + M.HD==1 + FPTR==1 + M1145==1 + FPP==1 + DCSPD==31 + M1140==0 + M40FPU==0 + LINEAD==174000 + .ENDC + .IFZ COMPUTER-2 + .TITLE RUG FOR THE TV 11/20 + TEN11==0 + FMH==0 + HCOR==60000 + CSTBL==20000 + F.HD==1 + DM11==0 + KL11==0 + M.HD==0 + FPTR==0 + M1145==0 + FPP==0 + DCSPD==0 + LINEAD==174000 + M1140==0 + M40FPU==0 + .ENDC + .IFZ COMPUTER-3 + .TITLE RUG FOR THE FREDKIN 11/40 + TEN11==0 + FMH==1 + HCOR==160000 + CSTBL==30000 + F.HD==0 + DM11==0 + KL11==0 + M.HD==1 + FPTR==1 + M1145==0 + FPP==0 + DCSPD==0 + M1140==1 + M40FPU==1 + LINEAD==175610 + .ENDC + .IFZ COMPUTER-4 + .TITLE RUG FOR SOMETHING OR OTHER + SETF ^\1=>FIXED DISK, 0=>NONE\,F.HD + SETF ^\1=>DM11, 0=>NONE\,DM11 + SETF ^\1=>USE FIRST KL11, 0=>USE CONSOLE TTY\,KL11 + SETF ^\1=>MOVING DISK, 0=>NONE\,M.HD + SETF ^\1=>FAST READER, 0=>CONSOLE READER\,FPTR + SETF ^\1=>FLOATING POINT, 0=>NONE\,FPP + SETF ^\1=>11/45, 0=>11/20\,M1145 + SETF ^\1=>11/40, O=>NOT\,M1145 + SETF ^\1=>11/40 FLOATING POINT, 0=>NONE\,M40FPU + SETF ^\CORE SIZE IN BYTES\,HCOR + SETF ^\ADDRESS OF BOTTOM OF SYMBOL TABLE\,CSTBL + SETF ^\0=>TRACK DUMP 1=>FILE DUMP\,FMH + SETF ^\DC11 SPEED SET (0, 1, 11 , 21 OR 31)\,DCSPD + SETF ^\TEN/11 INTERFACE\,TEN11 + SETF ^\LINE INTERFACE ADDRESS\,LINEAD + .ENDC + .MACRO PFLAG NAME,VAL + .PRINT /NAME'='VAL +/ + .ENDM + PFLAG TEN11,\TEN11 + PFLAG F.HD,\F.HD + PFLAG DM11,\DM11 + PFLAG KL11,\KL11 + PFLAG M.HD,\M.HD + PFLAG FPTR,\FPTR + PFLAG FPP,\FPP + PFLAG M1145,\M1145 + PFLAG M1140,\M1140 + PFLAG M40FPU,\M40FPU + PFLAG HCOR,\HCOR + PFLAG CSTBL,\CSTBL + PFLAG FILE DUMP,\FMH + PFLAG LINE ADDRESS,\LINEAD + PFLAG DC SPEED,\DCSPD + .ENDC + + +.IFZ M1145!M1140 +RUGFNT=HCOR-22000 +.IFF +RUGFNT=HCOR-40000 +.ENDC + ;RUG SYMBOLIC DEBUGGER +;RUG NEEDS THESE DISK BLOCKS RESERVED ON THE FIXED HEAD DISK +;THE SAME BLOCKS NEEDED ON THE MOVING HEAD DISK +;0,4-23, AND 54-217 + + +.MACR MVAD AAX,BBX + BBX==<<&377>/14>*20-<</14>*14>+&377 +.ENDM +.MACR MVADD AAX,BBX,CCX +.IFGE AAX&17+BBX&17-14 + CCX==AAX+BBX+4 +.IFF + CCX==AAX+BBX +.ENDC +.ENDM +.MACR MVBAD AAX,BBX ;CONVERT BLOCK NUMBER TO MOVING DISK ADDRESS + BBX==<<2*AAX>/14*20>+<2*AAX>-<<2*AAX>/14*14> +.ENDM + +A=%0 ; REGISTER +B=%1 ; NAMING +C=%2 ; CONVENTIONS +D=%3 +E=%4 +F=%5 +P=%6 +SP=%6 +PC=%7 +PSW=177776 ;STATUS REGISTER + +.XCREF A,B,C,D,E,F,P,SP,PC + +O.BPT==10 ;NUMBER OF BREAKPOINTS +O.BKP==O.BPT+O.BPT-2 ;NUMBER OF BREAKPOINTS-1 MULT. BY 2 +O.STM==340 ;PRIORITY MASK - STATUS REGISTER +O.TBT==20 ;T-BIT MASK - STATUS REGISTER + +.IFZ KL11 +O.RDB=177562 ;R DATA BUFFER +O.RCSR=177560 ;R C/SR +O.TDB=177566 ;T DATA BUFFER +O.TCSR=177564 ;T C/SR +.ENDC + +TTP50=100060 +.IFNZ KL11 +O.RDB=176502 +O.RCSR=176500 +O.TDB=176506 +O.TCSR=176504 +.ENDC + +DAE=177470 +DAR=177466 ;DISC ADDRESS (WORDS) +CMA=177464 ;CURRENT MEMORY LOC-2 +WC=177462 ;-WORDCOUNT (WORDS) +DCS=177460 ;DISC CNTL AND STATUS + + + +L.SR=177570 +L.DEV=DEVICE + ;THESE ARE RUGS CRUMBLING DISK ADDRESSES + +INVRG=4000 ;WHERE 'INVIOLATE COPY OF RUG STARTS ON DISC +INVRGL=/2 ;LENTH OF INVIOLATE COPY OF RUG + +.IFZ FMH +SPRG=INVRG+INVRGL ;WHERE SWAPPING PROGRAM STARTS +.IFF +SPRG=54000 +.ENDC + +SPRGL=&77777 ;LENTH OF SWAPPING PROGRAM ON DISC +SPRGLE=&77777 ;ROUNDED OFF LENTH JUST FOR NICENESS OF ADRESSES +SSTBL=SPRG+SPRGLE ;WHERE SWAPPING SYMBOL TABLE STARTS +SSTBLL=</2>&77777 ;LENTH OF SWAPPING SYMBOL TABLE + ;INCLUDES VOLATILE COPY OF RUG +SSTBUL=/2 ;THIS IS LENGTH OF USER'S SYMBOL TABLE +SSTBLE=</2>&77777 ;LENTH OF SYMBOL TABLE IN ROUNDER NUMBERS +;SSTBLL IS FROM CSTBL TO +;END OF DEBUGGER SO EVERYTHING SWAPPED +TRKS=SSTBL+SSTBLE ;WHERE TRACKS ON FIXED HEAD DISC START +TRKL=SPRGLE+SSTBLE-INVRGL ;LENTH OF TRACKS + +.IFNZ F.HD + DSKBSZ=40 ;DISK BLOCK SIZE + SSTBLB=SSTBL+>;LAST BLOCK OF +.ENDC ;SYMBOL TABLE +.IFZ F.HD + MVAD SPRGL,MSPRGL + MVAD SPRGLE,MSPGLE + MVAD SSTBLL,MSSTLL + MVAD SSTBLE,MSSTLE + MVAD INVRGL,MVIRGL +.IFZ FMH + LOWAD=250 ;LOWEST DAR OF MOVING HEAD DISK + MVADD LOWAD,MVIRGL,SPRG + MVADD SPRG,MSPGLE,SSTBL + MVADD SSTBL,MSSTLE,TRKS +.IFF + MVBAD 4,LOWAD + MVBAD 54,SPRG ;START OF CORE IMAGE + MVBAD 144,SSTBL ;START OF SYMBOLS + DSKBSZ=400 ;SIZE OF MOVING DISK SECTORS + MVAD >,SSTBLB ;LAST BLOCK OF SYMBOL TABLE + MVADD SSTBLB,SSTBL,SSTBLB +.ENDC +.ENDC + MVFO2=SSTBUL& ;HOW FAR SYMBOL TABLE EXTENDS INTO LAST BLOCK + MVAD TRKL,MTRKL + +.IFNZ M.HD +MTL=MTRKL +RKDS=177400 +RKCS=177404 +RKWC=177406 +RKBA=177410 +RKDA=177412 +.ENDC + +EOT==66 +TTP50=100060 +BUF3=1000 +BUF3B=2000 + +DMCSR=175000 +MASK=377 +BMASK=777 +DNTTYP==176 ;THE NULL CHAR + + +.IFNZ M1145 +THHCOR=0 ;0, 1, 2 OR 3 +LHHCOR=160000 +STACKR=-4 +SSR0=177572 +SSR3=172516 +XTCR=TRKS +;START OF EXTRA CORE ON DISK +.XTCR=&37777 ;LOCATION ON DISK SHIFTED TO ADD IN 16 BIT QUANTITIES +COR=<&60000>+<&17777> +.XTCRL=COR-&67777 ;LENTH OF CORE MORE THAN 28K +THXTCL=<.XTCR_14.>&3 ;TOP HALF OF PROPERLY SHIFTER EXTRA CORE LENTH +LHXTCL=<.XTCR_2> +.TRKS=.XTCR+.XTCRL + +THTRKS=<.TRKS_14.>&3 +LHTRKS=.TRKS_-2 +KIDR0=172300 ;CAN BE REMOVED BY REPLACING WHERE THEY ARE USED *** +SIDR0=172200 +UIDR0=177600 +KDDR0=172320 +SDDR0=172220 +UDDR0=177620 +KIAR0=172340 +SIAR0=172240 +UIAR0=177640 +KDAR0=172360 +SDAR0=172260 +UDAR0=177660 +.ENDC +;TOP AND LOW HALF OF HIGHEST CORE LOC +KILCHR=23 ;OCTAL 23 IS ^S + ;THESE MACROS ALLOW EASY CALLING OF MULTIPLY AND DIVIDE ROUTINES +;MLTPLY A,B,C DOES C_A*B, DIVIDE A,B,C,D DOES C_A/B AND D_REMAINDER +;MLTPLY SCRTCH,E,SCRTCH OR DIVIDE SCRTCH,E,SCRTCH,E ASSEMBLE NO OVERHEAD + +.MACRO MLTPLY A,B,C +.IF DIF A,SCRTCH + MOV A,SCRTCH +.ENDC +.IF DIF B,E + MOV B,E +.ENDC + JSR PC,MULT +.IF DIF C,SCRTCH + MOV SCRTCH,C +.ENDC +.ENDM + +.MACRO DIVIDE A,B,C,D +.IF DIF A,SCRTCH + MOV A,SCRTCH +.ENDC +.IF DIF B,E + MOV B,E +.ENDC + JSR PC,DIVD0 +.IF DIF C,SCRTCH + MOV SCRTCH,C +.ENDC +.IF DIF D,E + MOV E,D +.ENDC +.ENDM + ;THIS IS THE SYMBOL TABLE WHICH RUG SITS ON + +.=RUGFNT ;RUG'S SYMBOLS REQUIRE 56 BYTES + + + + BR RGO ;THIS SPECIAL "SYMBOL" MUST ALWAYS BE HERE!! + BR LOGO + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /%%%/ + .RAD50 /DUM/ + 0 + .RAD50 /.GO/ + 0 +ADRES: 1 ;USER STARTING ADDRESS, SHOULD BE ODD AT FIRST + .RAD50 /.B / + 0 + 14 + .RAD50 /.M / + 0 + 11 + .RAD50 /.P / + 0 + 10 + .RAD50 /.C / + 0 + 14+O.BPT + .RAD50 /..B/ + 0 +O.SYME: RUGFNT + .RAD50 /. / + 0 +DOT: 0 + 177777 ;HALF KILLED SYMBOL FLAG +DOTFLG: 74 +O.BSYM==. ;BEGINNING OF SYMBOL TABLE (HIGHEST ADDRESS) + +RGO: JMP O.ODT +LOGO: JMP STLOGO +BEGRUG: JMP STRT + +.=.+400 ;THIS IS RUG'S STACK + +O.UR0: 0 ;USER A +USERR0=O.UR0 + 0 ; B + 0 ; C + 0 ; D + 0 ; E + 0 ; F +USP: 0 ;USER SP +UPC: 0 +O.PRI: 7 ;RUG PRIORITY +O.MSK: -1 ;MASK + 0 ;LOW LIMIT + 160000 ;HIGH LIMIT +; +; BREAK POINT LISTS, ADR1 = ADDRESS OF BREAKPOINT,CT = COUNT, +; UIN = CONTENTS +; +O.ADR1: +.=.+O.BKP+2 +O.CT: +.=.+O.BKP+2 +O.UIN: +.=.+O.BKP+2 +.IFNZ M1145 +O.BPM: ;DESREG VALUE WHEN BPTS SET +.=.+O.BKP+2 +.ENDC + ;THIS IS THE MIGHTY RUG + +VERN: %FNAM2 ;RUG VERSION NUMBER +O.ODT: + MOVB #O.STM,PSW + MOV #O.UR0,SP + JMP O.DCD + +STRT: MOV #O.UR0,SP + JSR PC,REINIT + CLR RESTFL + CLR INPFL +.IFNZ F.HD + JSR 5,FDISK + 0 ;DAE + INVRG ;DAR + RUGFNT ;CMA + -INVRGL ;WC + 3 ;DCS +.ENDC + +.IFZ F.HD + JSR 5,MDISK + LOWAD + RUGFNT + -INVRGL + 3 +.ENDC + JSR PC,DSTBL + BR O.ODT + ADR1: 0 ;FIRST ADDRESS OF INSTRUCTION IN @DOT, OR DOT +ADR2: 0 ;SECOND, OR FIRST, OR DOT +ADR1F: .BYTE 0 ;0, OR 1 IF ADR1 IS A REGISTER +ADR2F: .BYTE 0 ;0, OR 1 IF ADR2 IS A REGISTER +OPENF: .BYTE 0 ;NONZERO IF LOCATION @DOT IS OPEN +.EVEN +REGFLG: 0 ;ONE IF DOT IS A REGISTER (OR .B, .C, .M, .P, ..B OR .) +BYTWRD: 1 ;ZERO IF EXAMINING IN BYTE MODE, 1 IF WORD + +;PROCESS /, OPEN A LOCATION + +SLASH: CLRB OPENF ;CLOSE LOC IF OPEN, BUT DON'T DEPOSIT ANY ARG + CLR REGFLG + TST C + BEQ SLASH3 ;NO ARGUMENT TYPED + TSTB REGINF + BEQ SLASH2 ;ARG NOT A REGISTER + CMP #43,E + BLT SLAERR ;INVALID REGISTER NUMBER + MOV E,DOT + INC REGFLG +SLASH1: JMP OPENW + +SLAERR: JMP O.ERR + +SLASH2: MOV E,DOT + BIT #1,E + BEQ SLASH1 + JSR 5,TYPE + .BYTE '/,0 ;TYPE A BACKSLASH + JMP OPENB ;ODD LOCATION SO OPEN BYTE + +SLASH3: JSR PC,SAVDOT ;STORE DOT IN RING BUFFER + CMP #GOINST,TEMPMD + BEQ SLASH4 ;TEMP MODE IS I, SO 2ND ADDRESS IS MEANINGFUL + CMP #GOINST,PERMMD + BNE TAB1 ;NOT IN I MODE, SO DO TAB +SLASH4: MOV ADR2,DOT ;OPEN SECOND ADDRESS + MOVB ADR2F,REGFLG ;LEFT BYTE ALWAYS ZERO + JMP TYOPEN + +;PROCESS \, OPEN A BYTE + +BACKSL: CLRB OPENF + TST C + BEQ TYOPEN ;NO ARGUMENT TYPED + CLR REGFLG + TSTB REGINF + BEQ BACKS1 ;NOT A REGISTER + CMP #43,E + BLT SLAERR ;INVALID REGISTER NUMBER + INC REGFLG +BACKS1: MOV E,DOT + JMP OPENB + ;PROCESS CARRIAGE RETURN + +CRETN: JSR PC,UPDATE + JSR PC,CLOSE + JMP O.DCD2 + +;PROCESS LINEFEED + +LINEFD: JSR PC,CLOSE + TST BYTWRD + BEQ LINEF3 + TST REGFLG + BNE LINEF3 ;A REGISTER OR .B, .C, ETC. + CMP #GOINST,TEMPMD + BNE LINEF2 ;NOT IN INSTRUCTION MODE + ADD LENGTH,DOT +LINEF2: INC DOT +LINEF3: INC DOT +TYOPEN: JSR PC,CRLF + MOV DOT,A ;NUMBER TO TYPE + JSR F,SYMBAD + TST BYTWRD + BEQ TYOPN1 ;IN BYTE MODE + TST REGFLG + BNE TYOPN2 + BIT #1,DOT + BNE TYOPN1 ;DOT IS ODD +TYOPN2: JSR F,TYPE + .BYTE '/,0 + JMP OPENW + +TYOPN1: JSR F,TYPE + .BYTE '\,0 + JMP OPENB + +;PROCESS TAB + +TAB: JSR PC,SAVD0 ;CLOSE, STORE DOT IN RING BUFFER +TAB1: MOV @WDINC,DOT + CLR REGFLG + BR TYOPEN + +;PROCESS _ (BACKARROW) + +BACKAR: JSR PC,SAVD0 ;CLOSE, STORE DOT IN RING BUFFER + MOV ADR1,DOT + MOVB ADR1F,REGFLG ;LEFT BYTE ALWAYS ZERO + BR TYOPEN + +;PROCESS ^ (UPARROW) + +UPARR: JSR PC,CLOSE + TST REGFLG + BEQ UPARR1 ;DOT IS NOT A REGISTER + TST DOT + BEQ UPARR3 ;DO NOT GO UP FROM A + BR UPARR2 + +UPARR1: SUB BYTWRD,DOT +UPARR2: DEC DOT +UPARR3: BR TYOPEN + ;PROCESS <, RETURN TO OLD SEQUENCE OF LOCATIONS + +OLDSEQ: JSR PC,UPDATE + JSR PC,CLOSE + MOV @RINGPT,DOT ;RESTORE DOT FROM RING BUFFER + CMP RINGPT,#RINGBF + BHI GETD1 + MOV #RINGBF+20,RINGPT +GETD1: SUB #2,RINGPT + CLR REGFLG ;CLEARS C ALSO + ROLB RINGRF + ADC REGFLG + TST REGFLG + BEQ GETD2 + INC RINGRF +GETD2: JMP TYOPEN + +SAVD0: JSR PC,CLOSE +SAVDOT: CMP RINGPT,#RINGBF+20-2 ;SAVE DOT AND REGFLG IN RING BUFFER + BLO SAVD1 + MOV #RINGBF-2,RINGPT +SAVD1: ADD #2,RINGPT + MOV DOT,@RINGPT + TST REGFLG ;CLEARS C + BEQ SAVD2 + SEC ;DOT IS REGISTER, SO SET C +SAVD2: RORB RINGRF ;BIT 7 IS REGFLG FOR ENTRY @RINGPT + RTS PC + +RINGBF: .REPT 8 ;RING BUFFER OF OPENED LOCATIONS FOR < COMMAND + 0 +.ENDR +RINGPT: RINGBF-2 ;RING BUFFER POINTER +RINGRF: 0 ;RIGHT BYTE IS REGISTER FLAGS FOR RING BUFFER + ;CLOSE THE LOCATION @DOT + +CLOSE: TSTB OPENF + BEQ CLOSE5 ;NO LOCATION OPEN + CLRB OPENF + TST C + BEQ CLOSE5 ;NO ARGUMENT TYPED + TST BYTWRD + BEQ CLOSEB ;CLOSE BYTE + MOV LENTYI,C + TST REGFLG + BEQ CLOSE2 + CLR C ;REGISTERS ARE ONLY 1 WORD +CLOSE2: MOV C,LENGTH + ASR C + MOV #VAL,D +.IFZ M1145 + MOV WDINC,A +CLOSE3: MOV (D)+,(A)+ ;DEPOSIT WORD +.ENDC +.IFNZ M1145 + MOV #WDINC,A +CLOSE3: BIT #1,(A) + BNE OPENER ;TO GETERR, BECAUSE NXM OR SLE + MOV (D)+,@(A)+ ;DEPOSIT WORD +.ENDC + DEC C + BMI CLOSE4 ;DONE DEPOSITING + BR CLOSE3 ;DO ANOTHER WORD + +CLOSEB: MOV DOT,C ;CLOSE A BYTE + BIC #177776,C ;GET LOW BIT + BIC REGFLG,C ;EXAMINE ONLY LOW BYTE OF REGISTERS + ADD WDINC,C + MOVB VAL,@C ;DEPOSIT THE BYTE +CLOSE4: TST REGFLG + BNE CLOSE5 ;DO NOT WRITE OUT REGISTERS + JSR PC,WRTWRD ;WRITE IT OUT +CLOSE5: RTS PC + ;OPEN A BYTE OR WORD, AS DESCRIBED BY DOT AND REGFLG +;SET BYTWRD ACCORDING TO WHETHER OPENB OR OPENW WAS CALLED + +OPENB: CLR BYTWRD + BR OPEN1 + +OPENW: MOV #1,BYTWRD +OPEN1: TST REGFLG + BEQ OPEN3 ;NOT A REGISTER + MOV DOT,E ;OPEN A REGISTER + ASL E +.IFNZ M1145 + CMP E,#12 ;P AND R7 ARE KEPT SEPERATLY + BLE OPEN0 + ADD #USERR0,E + BR OPEN.0 +OPEN0: ADD WCHREG,E +OPEN.0: +.IFF + ADD #USERR0,E +.ENDC + MOV E,WDINC +;SECOND OR THIRD WORD OF REGISTERS ARE NEVER REFERENCED, SO NO NEED TO SET UP + BR OPEN4 ;HAVE WORDS READY + +OPEN3: MOV DOT,A ;SET UP GETWRD CALL + MOV #NXMER,4 + MOV #340,6 + JSR PC,GETWRD +.IFNZ M1145 + BIT #1,WDINC + BEQ OPEN4 +OPENER: JMP GETERR ;NXM OR SLE +.ENDC +OPEN4: INCB OPENF + JSR PC,TYP3SP + MOV @WDINC,A ;PICK UP WORD +OPEN5: CLR LENGTH + TST BYTWRD + BNE OPEN7 ;NOT BYTE MODE + TST REGFLG + BNE OPEN6 ;CAN'T EXAMINE LEFT BYTE OF REGISTERS + BIT #1,DOT + BEQ OPEN6 + SWAB A ;WANT LEFT BYTE +OPEN6: BIC #177400,A ;MASK OFF LEFT BYTE +OPEN7: MOV A,CURVAL + JMP @TEMPMD + +GONUM: JSR 5,TYPNUM ;TYPE OUT NUMBER + BR GOSYM1 + +GOSYM: JSR 5,SYMBL2 ;PRINT AS SYMBOL EVEN IF IN $$A MODE +GOSYM1: JSR PC,TYP3SP + JMP O.DCD3 ;DONE + GOINST: TST REGFLG ;INSTRUCTION MODE TYPEOUT + BNE GONUM ;NO I MODE FOR REGISTERS + TST BYTWRD + BEQ GONUM ;NOR WITH BYTE MODE + MOV DOT,CURADR + MOV DOT,ADR1 + MOV DOT,ADR2 + CLR ADR1F ;CLEARS REG FLAG FOR ADR2 ALSO + JSR PC,EXINST + BR GOSYM1 ;OK + MOV CURVAL,A ;DID NOT FIND AN INSTRUCTION + BR GONUM + +PERMAF: .BYTE 0 ;NONZERO = TYPE ADDRS ABSOLUTE, ZERO = RELATIVE +TEMPAF: .BYTE 0 ;TEMP COPY OF PERMAF + +PERMDF: .BYTE 0 ;NONZERO = TYPE NUMBERS DECIMAL, ZERO = OCTAL +TEMPDF: .BYTE 0 ;TEMP COPY OF PERMDF + +PERMMD: GOINST ;C, I, S, R50 OR ASCII TYPEOUT MODE +TEMPMD: GOINST ;TEMP COPY OF PERMMD + +UPDATE: MOVB PERMAF,TEMPAF ;ABSOLUTE FLAG + MOVB PERMDF,TEMPDF ;DECIMAL FLAG + MOV PERMMD,TEMPMD ;TYPEOUT MODE + RTS PC + SETCMD: JSR PC,SETMOD ;SET CONSTANTS MODE + GONUM + +SETIMD: JSR PC,SETMOD ;SET INSTRUCTION MODE + GOINST + +SETSMD: JSR PC,SETMOD ;SET SYMBOLIC MODE + GOSYM + +SETR51: MOV C,D ;SHIFT ARG SINCE NO ALT MODE + MOV E,F +SETR50: JSR PC,SETMOD ;SET RADIX-50 MODE + GOR50 + +SETASD: MOV C,D + MOV E,F +SETASC: JSR PC,SETMOD ;SET ASCII MODE + GOASC + +SETMOD: CMP B,#2*+O.LGDR + BLO SETMD1 ;ZERO OR ONE ALT MODE + MOV @(SP),PERMMD ;TWO ALT MODES, SET MODE PERMANENTLY +SETMD1: MOV @(SP)+,TEMPMD +SETMD2: TST D + BEQ SETMD3 ;NO ARGUMENT + MOV F,CURVAL ;TYPE ARG IN NEW MODE + BR SETMD4 + +SETMD3: TSTB OPENF + BEQ O.DCD2 ;NO LOCATION OPEN +SETMD4: JSR PC,TYP3SP + MOV CURVAL,A + BR OPEN7 ;RETYPE VALUE + +S2ALTA: INCB PERMAF ;ABSOLUTE ADDRESSES +S1ALTA: INCB TEMPAF + BR SETMD2 + +S2ALTR: CLRB PERMAF ;RELATIVE ADDRESSES +S1ALTR: CLRB TEMPAF + BR SETMD2 + +S2ALTD: INCB PERMDF ;DECIMAL NUMBERS +S1ALTD: INCB TEMPDF + BR SETMD2 + +S2ALTO: CLRB PERMDF ;OCTAL NUMBERS +S1ALTO: CLRB TEMPDF + BR SETMD2 + + ; <:> DEFINE SYM AS CURRENT LOCATION +; <:> DEFINE SYM AS EXPR +; <,> <:> DEFINE SYM AS EXPR +; <,> <:> RE-DEFINE SYM AS EXPR + +;EVAL GOT UNDEFINED SYMBOL +ECOLON: CMP #COLONE,(SP)+ ;RETRIEVE CALL TO EVAL + BEQ COLONE ;IT WAS COLON COMMAND, SO ALREADY HAVE VALUE + TST C + BNE COLON0 + MOV DOT,E + MOV REGFLG,REGINF +COLON0: MOV E,DEFNV + MOV REGINF,-(SP) + BR COLONE + +COLON: MOV E,DEFNV ;PROCESS COLON COMMAND + CMPB #',,@PARSEP + BNE DCDERR ;COMMA MUST SEPARATE VALUE FROM SYMBOL + MOV REGINF,-(SP) + INC PARSEP ;PASS OVER COMMA + JSR PC,EVAL ;GET THE SYMBOL +COLONE: CMP #':,A + BNE DCDERR ;COLON MUST TERMINATE SYMBOL + TST NOTNUM + BEQ DCDERR ;CANNOT DEFINE NULL OR A NUMBER + JSR PC,O.SYLL ;GET SYMBOL'S VALUE IN E + BNE DEFN2 ;FOUND +DEFN1: SUB #6,O.SYME ;USYMB TABLE 2WDS RAD50 PLUS ONE OF VALUE + MOV O.SYL,(B) + MOV O.SYL+2,2(B) + MOV O.FLGS,E + CMP #1,D ;SEE IF TIME FOR NEW FLAG WORD + BNE DEFN2 ;NO + CLR (E) + CLR -(E) ;YES, INITIALIZE IT +DEFN2: MOV O.FLGS,E + MOV #0,4(B) +DEFNV=.-4 ;VALUE DEFINED + TST (SP)+ ;CHECK REGISTER FLAG + BEQ DEFN3 + BIS D,(E) + BR DEFN4 +DEFN3: BIC D,(E) +DEFN4: BIC D,-(E) + JSR PC,TYP3SP + BR O.DCD3 ;HAVE TO CLRB IBUFF FOR NON-COMMA MODES + +;PROCESS FOO^K, HALF KILLING DEFINED SYMBOL + +HKILL: MOV O.FLGS,E + MOV O.BIT,D + BEQ DCDERR + XOR D,-(E) + BR O.DCD + +RESART: MOVB #O.STM,PSW ;SET STATUS + MOV #O.UR0,SP ;INIT STACK + DECB RESTFL ;1=START RUG + BEQ O.DCD ;2=START TRACK 0 (LOGO) + CLRB RESTFL + JMP STLOGO ;START LOGO + + ;COMMAND DECODER, TOP LEVEL, MAY CLOBBER A - F + +O.ERR==. +DCDERR: CLRB TBUFF + MOV #TBUFF,TNPNTR + MOV #O.UR0,SP ;RESET STACK + JSR 5,TYPE ;GET HERE FROM FATAL ERRORS + .ASCIZ /? / + .EVEN + BR O.DCD3 + +O.DCD: CLRB OPENF ;MAKE NO LOCATION OPEN +O.DCD2: JSR PC,CRLF ;TYPE CR, LF, STAR + JSR 5,TYPE + .ASCIZ /*/ + .EVEN +O.DCD3: CLR SSFLAG ;SINGLE STEP MODE FLAG + JSR PC,INPUT ;GET A NEW COMMAND + MOV #IBUFF,PARSEP ;INITIALIZE PARSING POINTER + JSR PC,EVAL ;MAKE SOME SENSE OF INPUT + MOV #0,B +SALTF==.-2 ;SAVED ALTF FROM "INPUT", = 0, 1, 2 + CMP #2,B + BLO DCDERR ;TOO MANY ALTMODES + ASL B + MOV ALTTAB(B),B + DEC SINPTR ;UNDO LAST INC + MOVB @#0,A ;PICK UP COMMAND CHAR +SINPTR==.-2 ;SAVED INPNTR + CLRB IBUFF +DCD3: TSTB (B) ;SEARCH FOR COMMAND + BEQ DCDERR ;UNKNOWN COMMAND + CMPB A,(B)+ + BNE DCD3 ;KEEP LOOKING + SUB #ALT+1-,B + ASL B + MOV C,D ;C SAVED IN D, E IN F FOR 2 ALTMODE ROUTINES + MOV E,F ;THIS SHOULD BE DISCARDED *** + JMP @(B)+ ;DISPATCH TO PROPER ROUTINE + +ALTTAB: NOALT + ALT + TWOALT + ;PROCESS =, TYPE ARG OR CURRENT VALUE + +EQUAL: TST C + BEQ EQUAL1 ;NO ARG, USE CURVAL + MOV E,CURVAL ;ARG, SET CURVAL TO IT + TSTB REGINF + BEQ EQUAL1 + JSR 5,TYPE + .ASCIZ /%/ + .EVEN +EQUAL1: MOV CURVAL,A + JSR 5,TYPNUM +EQUAL2: JSR PC,TYP3SP + BR O.DCD3 + +;PROCESS ^V, TYPE VERSION NUMBER + +VERS: JSR F,TYPE + .ASCIZ / RUG / + .EVEN + MOV VERN,A + JSR F,TYPDEC +.IFNZ M1145 + MOV #43106,A ;ASCII F F + BIT #1,SVSSR0 + BEQ VERS1 + MOV #47040,A ;ASCII N SPACE +VERS1: MOV A,SONOFF + JSR 5,TYPE +MODE: .ASCII \P0 SEG O\ +SONOFF: .ASCII \FF\ + 0 +.ENDC + BR EQUAL2 + ERROR: BR O.ERR + +;PROCESS ], PRINT CURRENT VALUE AS RADIX-50 + +GOR50: MOV A,AINST + CLR AINST+2 + JSR 5,TYPE + .BYTE '& + .BYTE '/ + .BYTE 0 + .EVEN + MOVB #40,BLANK + JSR F,TYP50A +GOR50A: JSR 5,TYPE + .BYTE '/ + .BYTE 0 + JMP GOSYM1 + +;PROCESS [, PRINT CURRENT VALUE AS ASCII + +GOASC: BIS #100200,A ;SO DON'T HAVE ZEROS + MOV A,GOASCI + JSR 5,TYPE + .BYTE '" + .BYTE '/ +GOASCI: 0 + .BYTE 0 + .EVEN + BR GOR50A + +;SINGLE STEP MODE PROCESSOR +SSTP: TSTB O.P + BLT ERROR ;ILLEGAL TO PROCEED + MOV C,D + MOV E,F + CLR C +SSTEP: TST D + BGT SSTP1 + MOV #1,F ;ASSUME SINGLE STEP +SSTP1: TST F + BEQ ERROR ;ZERO STEPS? + CLR D + MOVB O.P,#0 +PP=.-2 + MOV F,COUNT + INC SSFLAG + JMP PR1 + ;B HANDLER - SET AND REMOVE BREAKPOINTS + +O.BKPT: MOV #-1,A + TST D + BEQ O.ERR1 ;FOR NOW THAT COMMAND IS MEANINGLESS + ASR F ;GET ONE BIT TO CARRY + BCS O.ERR1 ;BADNESS IF ODD ADDRESS + ASL F ;RESTORE ONE BIT + JSR PC,DELT1 ;D IS NOT 0 +;THIS IS SO NO TWO BPTS ON SAME ADDRESS PROBABLY A LOSS + MOV #O.ADR1,E +O.SET: CMP A,(E)+ ;IS THIS CELL FREE? + BEQ O.SET1 ;JUMP IF YES + CMP E,#O.BKP+O.ADR1+2 ;ARE WE AT THE END OF OUR ROPE + BLO O.SET + +O.SET1: MOV F,-(E) ;SET BREAKPOINT +.IFNZ M1145 + MOV MODE,O.BPM-O.ADR1(E) ;SAVE MAP STATE + CMPB #'P,MODE + BEQ O.DCDB + MOVB #'I,O.BPM+1-O.ADR1(E) ;SET MAP TO I SPACE +.ENDC +O.DCDB: JMP O.DCD ;RETURN + +;$$B HANDLER DELETE BKPT AT 1500 BY 1500$$B, $$B REMOVES ALL +DELT: CLR D +DELT1: MOV #-1,A + MOV #O.BKP+2,E +DBLOOP: TST D ;IF D ZERO, DELETE ALL + BEQ NOTST + CMP F,O.ADR1-2(E) + BNE DB1 ;ONLY REMOVE BKPT AT THAT ADDRESS +NOTST: MOV A,O.ADR1-2(E) + MOV #BPT,O.UIN-2(E) ;RESET CONTENTS OF TABLE + CLR O.CT-2(E) ;CLEAR COUNT +DB1: DEC E +.IFNZ M1145+M1140 + SOB E,DBLOOP +.IFF + DEC E + BGT DBLOOP +.ENDC + +DELDON: RTS PC +DELTB: JSR PC,DELT1 + BR O.DCDB +O.ERR1: JMP O.ERR + +; SEARCHES - $MSK HAS THE MASK +; $MSK+2 HAS THE FWA +; $MSK+4 HAS THE LWA + +NOTWDS: MOV #-1,EFFSR + BR O.WDS +O.EFF: MOV #1,EFFSR + BR O.WDS +O.WSCH: CLR EFFSR ;SET WORD SEARCH +O.WDS: CLR REGFLG + TST D ;CHECK FOR OBJECT FOUND + BEQ O.ERR1 ;ERROR IF NO OBJECT + MOV #1,BYTWRD ;SET WORD MODE + MOV O.MSK+2,C ;SET ORIGIN + MOV C,DISP + BIC #CSTBL-1,DISP + SUB DISP,C + JSR PC,INP1 + MOV O.MSK,E ;SET MASK + COM E +O.WDS2: CMP C,#CSTBL + BLO CS1 + JSR PC,INP +CS1: MOV C,A + ADD DISP,A + CMP A,O.MSK+4 ;IS THE SEARCH ALL DONE? + BHI INSB ;YES + MOV @C,A ;GET OBJECT + TST EFFSR ;NO + BGT O.EFF1 ;BRANCH IF EFFECTIVE SEARCH + MOV A,-(SP) + MOV F,D ;EXCLUSIVE OR + BIC F,A ; IS DONE + BIC (SP)+,D ; IN A VERY + BIS A,D ; FANCY MANNER HERE + BIC E,D ;AND RESULT WITH MASK + BNE WRD1 + TST EFFSR + BNE O.WDS4 + BR O.WDS3 +WRD1: TST EFFSR + BEQ O.WDS4 +O.WDS3: MOV E,-(SP) ;REGISTERS C,E, AND F ARE SAFE + MOV C,-(SP) + JSR PC,CRLF + MOV C,A ;GET READY TO TYPE + ADD DISP,A + JSR 5,SYMBAD ; TYPE ADDRESS + JSR F,TYPE + .BYTE '/,0 + JSR PC,TYP3SP + MOV (SP),C + MOV @C,A ;GET CONTENTS + JSR 5,TYPNUM ;TYPE CONTENTS + MOV (SP)+,C + MOV (SP)+,E ; RESTORE E +O.WDS4: TSTB O.RCSR + BMI O.ERR1 + TST (C)+ ;INCREMENT TO NEXT CELL AND + BR O.WDS2 ; RETURN + O.EFF1: CMP A,F ; IS (X)=K? + BEQ O.WDS3 ;TYPE IF EQUAL + MOV A,D ;(X) TO D + ADD C,D ;(X)+X + INC D + INC D ;(X)+X+2 + CMP D,F ;IS (X)+X+2=K? + BEQ O.WDS3 ;BRANCH IF EQUAL + TST A + BEQ O.WDS4 ;NOT A BRANCH INST + BIT #70000,A + BNE O.WDS4 ;ALSO NOT A BRANCH INST + MOVB A,A + INC A + ASL A + ADD C,A ;ADD PC + ADD DISP,A + CMP A,F ;IS THE RESULT A PROPER REL. BRANCH? + BNE O.WDS4 + BR O.WDS3 + +INSB: JMP O.DCD +EFFSR: 0 +DISP: 0 + + +INP: CLR C + ADD #CSTBL,DISP +INP1: MOV DISP,A + CLC + ROR A +.IFZ F.HD + MOV A,MDSAV + JSR PC,MDCNVT + MOV #SPRG,MDSAV+2 + JSR PC,MDADD + MOV MDSAV,INPDAR +.ENDC +.IFNZ F.HD + ADD #SPRG,A + MOV A,INPDAR + JSR 5,FDISK + 0 ;DAE +.ENDC +.IFZ F.HD + JSR 5,MDISK +.ENDC +INPDAR: 0 + 0 ;CMA + -CSTBL/2 ;WC + 5 ;DCS + RTS PC + + NXMER: + .IFNZ M1145 + BIT #1,SSR0 + BEQ NXMER1 + JSR PC,SEGRES ;RESTORE SEG REGISTERS IF SEG WAS ENABLED + .ENDC +NXMER1: MOV #O.UR0,P + JSR F,TYPE + .ASCIZ /NXM/ + .EVEN + JMP O.ERR + ; PROCESS G, START UP USER'S PROGRAM + +O.GO: TST D ;WAS ARGUMENT TYPED? + BNE GO2 +GO22: MOV ADRES,F +GO2: ASR F ;CHECK LOW ORDER BIT + BCS .ERR1 ;ERROR IF ODD NUMBER + ASL F ;RESTORE WORD + MOV F,UPC ;SET UP NEW PC +;NOW PUT THE BPT VECTOR INTO USER'S CORE +.IFNZ M1145 + MOV MODE,#0 +SAVMOD=.-2 + MOV #"KI,A + JSR PC,CHMODE ;CHANGE TO KERNAL MODE +.ENDC + MOV #14,A ;BPT VECTOR LOCATION + JSR PC,GETWRD +.IFZ M1145 + MOV WDINC,B + MOV #O.BRK,(B)+ + MOV #O.STM,(B) +.IFF + MOV #WDINC,B + MOV #O.BRK,@(B)+ + MOV #O.STM,@(B)+ ;+ 2ND TIME TO SAVE WORD IN ADRESS MODE +.ENDC + JSR PC,WRTWRD +.IFNZ M1145 + MOV SAVMOD,A + JSR PC,CHMODE +.ENDC +GO1: BIC #O.TBT,O.UST ;BOTH T-BIT FLAGS + JSR 5,O.RSB ;RESTORE BREAKPOINTS +O.GO2: MOVB #-1,O.P ;CLEAR PROCEED + MOVB #O.STM,PSW ;SET HIGH PRIORITY + JSR 5,O.RSTT ;RESTORE TELETYPE +.IFNZ M1145 + MOV MODE,#0 +SAVMOD=.-2 + MOV #"KI,A + JSR PC,CHMODE ;CHANGE TO KERNAL MODE +.ENDC + SUB #4,USP ;LIKE PUSHING TWO THINGS ON STACK + MOV USP,A +.IFNZ M1145 + MOV A,SAVKR6 + MOV #KIDR0+20,DESREG ;SO PUSH GOES INTO DATA SPACE +.ENDC + JSR PC,GETWRD +.IFZ M1145 + MOV WDINC,B + MOV UPC,(B)+ + MOV O.UST,(B) +.IFF + MOV #WDINC,B + MOV UPC,@(B)+ + MOV O.UST,@(B)+ +.ENDC + JSR PC,WRTWRD +;FALLS THROUGH + ;FALLS IN +.IFNZ DM11 + JSR PC,DM1LOS +.ENDC + MOV #O.UR0,SP + MOV (SP)+,SAVR0 + MOV (SP)+,SAVR1 +.IFNZ F.HD + MOV #DCS,B +.IFF + MOV #RKCS,B +.ENDC + MOV #SAVDCS,A + MOV (SP)+,C + MOV (SP)+,D + MOV (SP)+,E + MOV (SP)+,F +.IFNZ M1145 + MOV #KIDR0,DESREG ;RESTORE TO KI + MOV SAVSR6,-(SP) ;RESTORE SUPERVISOR P + BIS #10000,PSW ;SET PREV MODE TO SUP + MTPI P + MOV SAVUR6,-(SP) + BIS #30000,PSW ;SET MODE TO USER + MTPI P + MOV #ALTR0,SP + BIS #4000,PSW ;CHANGE TO REGISTER SET 1 + MOV (SP)+,A + MOV (SP)+,B + MOV (SP)+,C + MOV (SP)+,D + MOV (SP)+,E + MOV (SP)+,F + BIC #4000,PSW ;CHANGE BACK + MOV #USP,SP +.ENDC + JSR PC,DSTBL +.IFNZ F.HD + CLR CMA + CLR DAE + MOV #SPRG,DAR + MOV #-SPRGL,WC +.IFF + CLR RKBA + MOV #SPRG,RKDA + MOV #-SPRGL,RKWC +.ENDC + MOV (SP),SP + MOV #4,(B) + JMP GOGO + + + ; PROCESS P - PROCEED (ONLY ALLOWED AFTER A BREAKPOINT) + +.ERR1: JMP O.ERR +O.PROC: MOVB O.P,A + TSTB A ;CHECK LEGALITY OF PROCEED + BLT .ERR1 ;NOT LEGAL + TST D ;WAS COUNT SPECIFIED? + BNE PR.0 ;NO + MOV #1,F +PR.0: MOV F,O.CT(A) ;YES, PUT AWAY COUNT +PR0: INCB O.T ;SET RESTART TBIT + +PR1: BIS #O.TBT,O.UST ;SET T-BIT + BR O.GO2 + + +O.TBIT: DEC COUNT + BLE SSDN ;DONE SINGLE STEPPING +O.TBI1: BIT #4000,O.RCSR ;IS CHAR COMING IN? + BNE O.TBI1 + TSTB O.RCSR ;TEST FOR KILCHR DURING MULTIPLE  + BPL PR1 + CMPB #KILCHR,O.RDB + BNE PR1 +SSDN: MOVB PP,O.P + MOV UPC,F + MOV F,DOT + MOV #"SS,BBMES + BR BB + + ; BREAKPOINT HANDLER +; A TRT BREAKPOINT CAUSES O.BRK TO BE ENTERED, +; WHICH SAVES VARIOUS ODDS AND ENDS, FINDS OUT +; IF THE BREAKPOINT WAS LEGAL, AND GIVES CONTROL +; TO THE COMMAND DECODER. + +BREAK: MOVB #O.STM,PSW + MOV #UPC,SP + MOV O.UPC,(SP) + MOV O.USP,-(SP) +.IFNZ M1145 + MOV (SP),SAVKR6 ;KERNEL MODE STACK POINTER +.ENDC + MOV F,-(SP) + MOV E,-(SP) + MOV D,-(SP) + MOV C,-(SP) + MOV SAVR1,-(SP) + MOV SAVR0,-(SP) +.IFNZ M1145 + BIS #10000,PSW ;SET TO SUP MODE + MFPI P + MOV (SP)+,SAVSR6 + BIS #30000,PSW ;PREVIOUS MODE USER MODE + MFPI P + MOV (SP)+,SAVUR6 + MOV @R6AD,USP ;SET CORRECT P STACK VALUE + MOV #ALTR0,SP + BIS #4000,PSW ;SAVE REGISTER SET 1 + MOV A,(SP)+ + MOV B,(SP)+ + MOV C,(SP)+ + MOV D,(SP)+ + MOV E,(SP)+ + MOV F,(SP)+ + BIC #4000,PSW + MOV #O.UR0,SP +.ENDC + + JSR 5,O.SVTT ;SAVE TTY +.IFNZ M1145 + MOV SAVMOD,A + JSR PC,CHMODE ;RESET MODE +.ENDC + TSTB RESTFL + BEQ BRK1 + DECB RESTFL + BEQ BREK.1 + CLRB RESTFL + JMP STLOGO ;START LOGO +BREK.1: CLRB O.T + CLRB SSFLAG + JSR F,O.REM + JMP O.DCD +BRK1: TSTB SSFLAG ;CHECK FOR T-BIT SET BY ^N + BNE O.TBIT ;JUMP IF SET + TSTB O.T ;CHECK FOR T-BIT SET BY $P + BEQ O.BK2 + CLRB O.T + JMP GO1 ;CONTINUE USER PROGRAM + ;RUG USED TO SWAP OUT HIGH CORE HERE +O.BK2: JSR 5,O.REM ;REMOVE BREAKPOINTS +O.BK3: MOV UPC,F ;GET PC, IT POINTS TO THE TRT + SUB #2,F ;CAN'T TST -(F) BECAUSE COULD BE RANDOM + MOV #O.BKP,E ;GET A COUNTER +O.B1: CMP F,O.ADR1(E) ;COMPARE WITH LIST + BEQ O.B2 ;JUMP IF FOUND + SUB #2,E ;CAN'T TEST. IT GETS NEG + BGE O.B1 ;RE-LOOP UNTIL FOUND +BADEN: MOV #"BE,BBMES + CLRB O.P ;TO ALLOW RESTART AFTER BAD ENTRY +BB: MOV F,A + BIC #O.TBT,O.UST ;CLEAR OUT ANY POSSIBLE FAKE T-BIT + JSR PC,CRLF + JSR 5,TYPE +BBMES: .ASCIZ /BE;/ + .EVEN + BR O.B3 ; OR CONTINUE + +O.B2: +.IFNZ M1145 + MOV O.BPM(E),A ;RESTORE MODE OF BREAKPOINT + JSR PC,CHMODE +.ENDC + + MOV F,UPC ;WANT DECREMENTED PC + MOVB E,O.P ;ALLOW PROCEED + DEC O.CT(E) + BLE O.B5 + JMP PR0 + +O.B5: MOV #1,O.CT(E) ;RESET COUNT TO 1 + MOVB E,A + ADD #140,A + ASR A + MOVB A,BPTNM + JSR PC,CRLF + JSR 5,TYPE +BPTNM==.+1 + .ASCIZ /B ;/ + .EVEN + MOV #1,BYTWRD ;SET WORD MODE + MOVB O.P,E + MOV O.ADR1(E),A ;GET ADDRESS OF BREAK +O.B3: MOV A,CURADR + JSR PC,GETWRD + MOV CURADR,A ;ARG FOR SYMBOL IN A + JSR 5,SYMBOL ;LOOK UP SYMBOL, TYPE IT AND ANY OFFSET + JSR 5,TYPE + .ASCIZ />/ + .EVEN + CLR LENGTH + MOV @WDINC,A + JSR PC,EXINST + BR O.B4 + JMP O.ERR ;NO INSTUCTION FOUND +O.B4: JMP O.DCD ;GO TO DECODER + + +.IFNZ DM11 +DM1LOS: MOV #TTP50,O.SYL + CLR O.SYL+2 + JSR PC,O.SYLL + BEQ DMLO.1 +DMLOSS: MOV DMCSR+6,D + ADD #200,D + MOV E,A + JSR PC,GETWRD + MOV D,@WDINC + JSR PC,WRTWRD +DMLO.1: RTS PC +.ENDC + .IFZ M1145 + +;GET WORDS FROM DISK AROUND LOCATION IN A + +GETWRD: CMP A,#RUGST ;READ WHAT IN CORE IF THAT HIGH + BLO GTWRD1 + MOV #GWTBL,B ;THINGS IN THIS TABLE +GW2: TST (B) ;ARE STORED BY RUG + BEQ GW1 + CMP A,(B)+ + BNE GW2 + ADD #GWTBL2-GWTBL-2,B ;POINT TO SAVE AREA AND B INCREMENTED EXTRA + MOV @B,A +GW1: MOV #BUF3,WDINC + MOV (A),BUF3 ;PUT THREE WORDS WHERE THE USER CAN GET THEM + CLR BUF3+2 + CLR BUF3+4 + MOV #1,IOREG ;SET SWITCH + MOV A,ADRSG + RTS PC +GTWRD1: CLR IOREG ;SET SWITCH + CLC + ROR A ;WORD ADDRESS + MOV B,-(SP) + MOV C,-(SP) + MOV A,B + BIC #MASK,B ;GET NEAREST BLOCK BOUNDARY + MOV A,C + SUB B,C ;OFFSET FROM BLOCK BOUNDARY + ASL C + ADD #BUF3,C ;IT SHOULD BE HERE SOON + MOV C,WDINC + ADD #3,A + CMP A,#HCOR/2-1 ;WILL THERE BE NXM IF 3 WDS? + BLO GTWRD2 + MOV #HCOR/2-1,A +GTWRD2: +.IFNZ F.HD + MOV B,ADRSG + ADD #SPRG,ADRSG ;DISK ADDRESS TO START TRANSFER FROM +.ENDC +.IFZ F.HD + MOV B,MDSAV + JSR PC,MDCNVT + MOV #SPRG,MDSAV+2 + JSR PC,MDADD + MOV MDSAV,ADRSG +.ENDC + SUB A,B ;NEGATIVE OFFSET FROM BLOCK BOUNDARY TO END + BIC #MASK,B ;OF 3 WORDS (UNROUNDED WC) + MOV B,WDCNT + MOV #5,GWFUN + MOV (SP)+,C + MOV (SP)+,B +GWDSK: +.IFNZ F.HD + JSR 5,FDISK + 0 ;DAE +.ENDC +.IFZ F.HD + JSR 5,MDISK +.ENDC +ADRSG: 0 ;DAR + BUF3 ;CMA +WDCNT: 0 ;WC +GWFUN: 0 ;DCS +STH4: RTS PC + +WDINC: 0 ;POINTER TO WORD IN CORE (11/45 NEEDS THREE SUCH) + +WRTWRD: TST IOREG + BEQ WRTW1 + CLR IOREG + MOV BUF3,@ADRSG + RTS PC +WRTW1: MOV #3,GWFUN + BR GWDSK +.ENDC + + +ZZERO: CLR 0 +.IFNZ F.HD + JSR 5,FDISK + 400 ;DAE +.ENDC +.IFZ F.HD + JSR 5,MDISK +.ENDC + SPRG ;DAR + 0 ;CMA + -SPRGL ;WC +.IFNZ F.HD + 3 ;DCS +.ENDC +.IFZ F.HD + 4003 ;RKCS WITH INC INHIBIT ON +.ENDC + RTS PC + + +ZEROAL: MOV #RUGFNT,O.SYME +ZERO: JSR PC,ZZERO + JMP O.DCD + + +IOREG: 0 + GWTBL: PSW ;TABLE OF I/O REGISTERS SAVED IN RUG +.IFNZ DM11 + DMCSR +.ENDC +.IFNZ M1145 + STACKR + SSR0 + SSR3 +.ENDC +.IFNZ F.HD + DCS + WC + CMA + DAR + DAE +.ENDC +.IFZ F.HD + RKCS + RKWC + RKBA + RKDA +.ENDC + 0 + +GWTBL2: O.UST ;AND WHERE THEY'RE SAVED +.IFNZ DM11 + SAVDM +.ENDC +.IFNZ M1145 + SAVSLR + SVSSR0 + SVSSR3 +.ENDC + SAVDCS + SAVWC + SAVCMA + SAVDAR +.IFNZ F.HD + SAVDAE +.ENDC + .IFNZ M1145 +;THIS ROUTINE GETS A VIRTUAL ADDRESS IN A AND RETURNS +;A PHSICAL ADDRESS IN C AND R3. B IS FLAG. <=0 IS OK IF NOT-NXM + +CNVVP: CLR SEGLE + MOV A,-(SP) + MOV DESREG,D + BEQ PHYSMOD + BIT #1,SVSSR0 ;BIT IN SSR0 PREDOMINATES OVER NON-PHYS MODE SELECTION + BEQ SEGOFF + MOV A,B + ASH #-12.,B ;ASF*2 + BIC #177761,B + ADD D,B ;NOW CHECK IF D SPACE IS DISABLED + BIT #20,D ;IS IT IN D SPACE? + BEQ CNVV.1 + ASH #-6,D + INC D + BIC #177771,D + CMP D,#4 + BLE CNVV.0 + MOV #1,D ;D IS MASK TO TEST SRR3 +CNVV.0: BIT D,SVSSR3 ;IS D SPACE DISABLED + BNE CNVV.1 + SUB #20,B ;NOW B HAS PROPER DESCRIPTOR REG +CNVV.1: MOV 40(B),D ;D HAS SAR + CLR C + ASHC #6,C ;NOW SAF LINED UP WITH BLOCK NUMBER +;MAY NEED TO MASK OFF TOP BITS AFTER ASHC *** + BIC #160000,A ;TOP 3 BITS ONLY FOR WHICH SEGREG + ADD A,D + ADC C ;BLOCK # RIGHT JUSTIF. ADC CLEARS CARRY + ASH #-6,A + MOV (B),B ;HAS CONTENTS OF DESCRIPTOR REG + SWAB B + BIT #4000,B + BNE DWNBLK + BIC #177600,B + CMP A,B + BGT SLE +HAVPA: CLR B + CMP C,#3 ;IS IT AN I/O REG? + BNE HAVPA1 ;NO + CMP D,#160000 ;MAYBE + BHIS HAVPA2 ;YES +HAVPA1: TST C ;ARE WE IN RUG'S CORE + BNE HAVPAR ;NOPE + CMP D,#160000 ;ABOVE RUG? + BHIS HAVPAR + CMP D,#RUGST ;MAYBE + BLO HAVPAR ;NO, INDICATE THAT IT IS REAL CORE, NOT ON DISK +HAVPA2: COM B ;MEANING IO REG OR RESIDENT PORTION OF RUG +HAVPAR: MOV (SP)+,A + RTS PC +DWNBLK: BIC #177600,B + CMP A,B + BGE HAVPA +SLE: INC (PC)+ +SEGLE: 0 ;NONZERO = SEG LENGTH ERROR +;FALL INTO NXM +NXM: INC B ;NOW B HAS TO BE POSITIVE + BR HAVPAR +PHYSMOD: MOV A,D + MOV THPHYM,C + BR HAVPA +SEGOFF: MOV A,D + CLR C ;WITH SEGMENTATION OFF, ALL ADDRESS ARE IN THE LOWER 28K + CMP D,#160000 ;UNLESS THEY ARE I/O REGISTERS + BLO HAVPA + MOV #3,C ;IN WHICH CASE THEY ARE IN THE TOP 4K + BR HAVPA + +DESREG: 0 ;ADDRESS OF DESCRIPTOR REG 0 OF THAT MODE +;OR CONTAINS 0 IF IN PHYSICAL MODE + SVSTSG: MOV A,-(SP) + MOV #172300,A ;POINTER TO SEGMENTATION REGISTERS + MOV #SEGSAV,B ;PLACE TO SAVE THEM + MOV #40,E ;HOW MANY TO SAVE +SVSTS0: MOV (A)+,(B)+ + SOB E,SVSTS0 + MOV #172300,A ;NOW SET THEM UP + CLR B + MOV #10,E ;4 AT A TIME +SVSTS1: MOV B,60(A) ;PAR + MOV B,40(A) ;PAR + MOV #77606,20(A) ;PDR + MOV #77606,(A)+ ;PDR + ADD #200,B + SOB E,SVSTS1 + MOV C,172342 + MOV C,172362 + MOV #7600,172356 + MOV #7600,172376 + BIS #1,SSR0 ;TURN ON SEGMENTATION + MOV (SP)+,A + RTS PC + +SEGRES: MOV A,-(SP) ;RESTORE SEGMENTATION REGISTERS + BIC #1,SSR0 ;DISABLE SEGMENTATION + MOV #172300,A + MOV #SEGSAV,B + MOV #40,E +SEGRE1: MOV (B)+,(A)+ + SOB E,SEGRE1 + MOV (SP)+,A + RTS PC +SEGSAV: .BLKW 40 + +GHCOR: MOV D,-(SP) + ASHC #-6,C + MOV D,C + JSR PC,SVSTSG + MOV (SP)+,D + BIC #177700,D + ADD #20000,D + MOV C,IOREG + MOV D,GADAR + MOV #BUF3,C + MOV #3,B + MOV #WDINC,A + MOV 4,-(SP) + MOV #GHCRNX,4 +GHCOR1: MOV C,(A)+ + MOV (D)+,(C)+ + SOB B,GHCOR1 + MOV (SP)+,4 + JSR PC,SEGRES + JMP GDONE2 +GHCRNX: INC -2(A) ;MAKE IT ODD +WRHCNX: RTI ;AND IGNORE IT + +GETWRD: BIC #1,A ;SET TO WORD BOUNDARY + MOV A,VADR ;VIRTUAL ADDRESS + CLR IOREG + CLR TWOFLG + MOV B,-(SP) + MOV D,-(SP) + MOV C,-(SP) + MOV E,-(SP) + JSR PC,CNVVP ;PHYSICAL ADDRESS IN C,D + TST B + BLT GETCOR ;ITS AN I/O REGISTER + BEQ GTDSK ;ITS LEGAL CORE + TST SEGLE + BEQ NX + JMP SLERR ;NOT ALLOWED TO HAVE ERRORS ON FIRST WORD +NX: JMP NXMER + +GETCOR: INC IOREG ;IT'S AN I/O REGISTER + MOV #GWTBL,B +GW2: TST @B + BEQ GW1 + CMP A,(B)+ + BNE GW2 + ADD #GWTBL2-GWTBL-2,B + MOV @B,D ;POINT TO SAVE AREA +GW1: MOV #WDINC,B + MOV #3,A +GW3: MOV D,(B)+ + ADD #2,D + SOB A,GW3 + BR GDONE2 + + ;GET THREE WORDS FROM DISK OR WHEREEVER +GTDSK: TST C + BNE GHCOR ;JUST LOOK IN CORE + CMP D,#160000 + BHIS GHCOR ;JUST LOOK AT CORE + MOV #3,B + JSR PC,GDSK ;TURN VADR INTO DISK ADDRESS + MOV ADAR,GADAR +.IFNZ F.HD + MOV ADAE,GADAE +.ENDC + MOV AWDCNT,GWDCNT ;SAVE THE COMPUTED DISK REGISTERS + MOV #BUF3,WDINC + ADD AWDINC,WDINC ;NOW POINTS INTO BUFFER +GDLOP: DEC B + BEQ NODIF ;ALL THREE WORDS IN ONE TRANSFER + JSR PC,GDSK ;DO VADR+2 OR VADR+4 (IF SECOND TIME THROUGH) + BLT NXMER2 ;VADR+2 OR VADR+4 IS NXM + CMP GADAR,ADAR +.IFZ F.HD + BEQ GDLOP ;SAME TRANSFER AS PREVIOUS +.ENDC +.IFNZ F.HD + BNE TWOGET ;TWO TRANSFERS NECESSARY + CMP GADAE,ADAE + BEQ GDLOP ;SAME AS PREVIOUS TRANSFER +.ENDC +TWOGET: INC TWOFLG + DEC B + BEQ LASTD ;ONLY ONE WORD TO GO + MOV #BUF3B,B ;TWO WORDS ON NEXT DISK SECTOR + ADD AWDINC,B + MOV B,WDINC+2 ;VADR+2 AND VADR+4 IN OTHER BUFFER + TST (B)+ + BR LASTD2 ;NOW STORE THE DISK TRANSFER INFO + +NODIF: MOV WDINC,B ;ALL 3 WORDS ARE TOGETHER + TST (B)+ + MOV B,WDINC+2 ;POINTS TO SECOND WORD + TST (B)+ + MOV B,WDINC+4 ;TO THIRD WORD + BR GDONE1 ;FIDDLE THE DISK + +LASTD: MOV WDINC,B ;ONLY VADR+4 IN SECOND BUFFER + TST (B)+ + MOV B,WDINC+2 ;VADR+2 IN FIRST BUFFER + MOV #BUF3B,B + ADD AWDINC,B ;VADR+4 IN SECOND BUFFER +LASTD2: MOV B,WDINC+4 + MOV ADAR,GADAR2 ;INFO FOR SECOND TRANSFER +.IFNZ F.HD + MOV ADAE,GADAE2 +.ENDC + MOV AWDCNT,GWDCN2 +GDONE1: MOV #5,B + JSR PC,GDISK ;DO THE TRANSFER(S) +GDONE2: MOV (SP)+,E + MOV (SP)+,C + MOV (SP)+,D + MOV (SP)+,B + RTS PC + +WRTWRD: MOV IOREG,C + BEQ WRTW1 + CLR IOREG + CMP #1,C ;IS JUST AN I/O REGISTER? + BEQ WRTW2 ;YES, DONE + JSR PC,SVSTSG + MOV GADAR,D + MOV #BUF3,C + MOV 4,-(SP) + MOV #WRHCNX,4 + MOV (C)+,(D)+ + MOV (C)+,(D)+ + MOV (C)+,(D)+ + MOV (SP)+,4 + JSR PC,SEGRES +WRTW2: RTS PC +WRTW1: MOV #3,B ;FALL INTO GDISK + +GDISK: MOV B,GFUN + JSR PC,GDSK1 + TST TWOFLG + BEQ GDSKD + MOV B,GFUN2 +GDSK2: +.IFNZ F.HD + JSR 5,FDISK +GADAE2: 0 +.ENDC +.IFZ F.HD + JSR 5,MDISK +.ENDC +GADAR2: 0 + BUF3B +GWDCN2: 0 +GFUN2: 0 +GDSKD: RTS PC + +GDSK1: +.IFNZ F.HD + JSR 5,FDISK +GADAE: 0 +.ENDC +.IFZ F.HD + JSR 5,MDISK +.ENDC +GADAR: 0 + BUF3 ;CMA +GWDCNT: 0 +GFUN: 0 + RTS PC +NXMER2: NEG B + ASL B + MOV #1,WDINC(B) ;INDICATE NXM + MOV #1,WDINC+2(B) ;CAN'T HAVE THIS EITHER + BR GDONE1 + +TWOFLG: 0 + +WDINC: 0 ;POINTER TO FIRST WORD + 0 ;POINTER TO NEXT + 0 ;THESE POINTERS ARE ODD IF NXMS OR SLES + 0 ;FOR NXMER2 KLUDGE + + ;PHYSICAL ADDRESS IN A + +;IN B IS 3 2 OR 1 DEPENDING ON WHICH TIME THROUGH LOOP +;ADDRESS IN D AND C + +GDSK: MOV VADR,A ;VIRTUAL ADDRESS + MOV B,-(SP) + NEG B + ADD #3,B + ASL B + ADD B,A ;GET ACTUAL ADDRESS + JSR PC,CNVVP ;MAKE A PHYSICAL ADDRESS + TST B + BNE GDNXM ;NXM + TST C + BNE GDNXM + MOV D,B ;C SHOULD BE ZERO + BIC #BMASK,D + MOV B,A + SUB D,A ;OFFSET INTO DISK BLOCK + MOV A,AWDINC ;SAVE IT + CLC + ROR D ;MAKE IT A WORD ADDRESS +.IFNZ F.HD + ADD #SPRG,D ;OFFSET INTO SWAP TRACK + ADC C + MOV C,ADAE + MOV D,ADAR +.ENDC +.IFZ F.HD + MOV D,MDSAV + JSR PC,MDCNVT + MOV #SPRG,MDSAV+2 + JSR PC,MDADD + MOV MDSAV,ADAR +.ENDC + MOV #-400,AWDCNT + MOV (SP)+,B + RTS PC +ADAR: 0 +.IFNZ F.HD +ADAE: 0 +.ENDC +AWDINC: 0 +AWDCNT: 0 +VADR: 0 ;VIRTUAL ADDRESS + +GDNXM: MOV (SP)+,B + SUB #3,B ;SO WILL BE NEG AND NO INFO LOST + RTS PC + ;CHANGE MODES. CHOICE OF P, KI, KD, SI, SD, UI OR UD +;FOR PHYSICAL MODE OR KERNEL INSTRUCTION, ETC. +;TYPE $$M THEN IT ASKS MODE? THEN TYPE ONE OF CHOICES ABOVE +;THIS SETS UP DESREG TO BE PROPER ADDRESS OF DESCRIPTOR REG +;FOR THAT MODE, DATAMF SIGNALS WHETHER IT'S DATA SPACE + +CHNGMD: JSR 5,TYPE + .ASCIZ /ODE / + .EVEN + JSR PC,GET1UC + MOV A,-(SP) + JSR PC,GET1UC + SWAB A + BIS (SP)+,A + JSR PC,CHMODE +MODE.1: JMP O.DCD + + +CHMODE: MOV B,-(SP) + MOV #CHNGL,B ;CHANGE MODE TO (A) +CHNG1: CMP A,(B)+ + BEQ CHNG2 ;GOT LEGAL NEW MODE + CMP #CHNGL+20.,B + BHI CHNG1 + CMP A,#"R0 + BNE CHMO.1 + MOV #O.UR0,#O.UR0 ;CHANGE TO REGISTER SET 0 +WCHREG=.-2 + BR CHNG4 +CHMO.1: CMP A,#"R1 + BNE CHMO.2 + MOV #ALTR0,WCHREG ;CHANGE TO REGISTER SET 0 + BR CHNG4 +CHMO.2: JMP O.ERR ;NOT A LEGAL MODE + +CHNG2: MOV A,MODE + MOV CHDREG-CHNGL-2(B),DESREG + CLR B + MOVB A,B + SUB #121,B + BGT CHNG3 + CLR B +CHNG3: ADD #SAVKR6,B + MOV USP,@R6AD + MOV B,R6AD + MOV (B),USP + SWAB A + MOV A,THPHYM + BIC #177774,THPHYM ;0-3 IN P MODE, ELSE IRRELEVANT +CHNG4: MOV (SP)+,B + RTS PC + + +KMODE: MOV #'K,B + BR MODE.2 +UMODE: MOV #'U,B +MODE.2: JSR PC,GET1UC + SWAB A + BIS B,A ;MODE IS NOW IN A + JSR PC,CHMODE + BR MODE.1 + +CHNGL: .ASCII \P0\ + .ASCII \P1\ + .ASCII \P2\ + .ASCII \P3\ + .ASCII \KI\ + .ASCII \KD\ + .ASCII \SI\ + .ASCII \SD\ + .ASCII \UI\ + .ASCII \UD\ + +SAVKR6: 0 ;SAVED KERNEL, SUP, USER P'S +SAVSR6: 0 +SAVUR6: 0 +R6AD: SAVKR6 ;POINTER TO CURRENT SAVED P + + +ALTR0: 0 ;SAVE ALTERNATE REGISTER SET HERE +ALTR1: 0 +ALTR2: 0 +ALTR3: 0 +ALTR4: 0 +ALTR5: 0 + + +THPHYM: 0 ;BITS 17 & 16 OF PHYS MODE ADDRESS, = 0-3 + +CHDREG: 0 ;DESCRIPTOR REGISTER FOR EACH MODE + 0 + 0 + 0 + KIDR0 + KIDR0+20 + SIDR0 + SIDR0+20 + UIDR0 + UIDR0+20 +.ENDC + ; RESTORE BREAKPOINTS 0-7 + +O.RSB: MOV #O.BKP,E ;RESTORE ALL BREAKPOINTS +O.RS1: MOV O.ADR1(E),A + CMP A,#-1 + BEQ O.RS2 +.IFNZ M1145 + MOV A,B + MOV O.BPM(E),A + JSR PC,CHMODE + MOV B,A +.ENDC + JSR PC,GETWRD + MOV @WDINC,O.UIN(E) + MOV #3,@WDINC + JSR PC,WRTWRD +O.RS2: DEC E + DEC E + BGE O.RS1 ;RE-LOOP UNTIL DONE + RTS F ;THEN QUIT + +;SAVE TELETYPE STATUS + +O.SVTT: MOVB O.RCSR,O.CSR1 ;SAVE R C/SR + MOVB O.TCSR,O.CSR2 ;SAVE T C/SR + CLRB O.RCSR ;CLEAR ENABLE AND MAINTENANCE BITS + CLRB O.TCSR ;IN BOTH C/SR + RTS F + ; RESTORE TELETYPE STATUS + +O.RSTT: TST O.T + BNE RSTT + TST SSFLAG + BNE RSTT + JSR PC,CRLF +RSTT: TSTB O.TCSR ;WAIT READY + BPL RSTT ; ON PRINTER + BIT #4000,O.RCSR ;CHECK BUSY FLAG + BEQ O.RSE1 ;SKIP READY LOOP IF NOT BUSY +1$: TSTB O.RCSR ;WAIT READY + BPL 1$ ; ON READER +O.RSE1: MOVB O.CSR1,O.RCSR ;RESTORE + MOVB O.CSR2,O.TCSR ; THE STATUS REGISTERS + RTS F + +;REMOVE BREAKPOINTS 0-7, IN THE OPPOSITE ORDER OF SETTING + +O.REM: CLR E ;REMOVE ALL BREAKPOINTS +O.R1: MOV O.ADR1(E),A + CMP A,#-1 + BEQ O.R2 +.IFNZ M1145 + MOV A,B + MOV O.BPM(E),A + JSR PC,CHMODE + MOV B,A +.ENDC + JSR PC,GETWRD + MOV O.UIN(E),@WDINC + JSR PC,WRTWRD +O.R2: TST (E)+ + CMP E,#O.BKP + BLE O.R1 ;RE-LOOP UNTIL DONE + RTS F ;THEN QUIT + ;TYPE OUT NUMBER IN A, OCTAL OR SIGNED DECIMAL AS PER TEMPDF +;PURELY OCTAL TYPEOUT CAN JSR TO TYPOCT, DECIMAL TO TYPDEC + +TYPNUM: TSTB TEMPDF + BNE TYPDEC ;DECIMAL +TYPOCT: MOV #NUMBUF+7,D ;OCTAL +TYPOC1: MOV A,E + BIC #177770,E + ADD #'0,E ;GET CHARACTER + MOVB E,-(D) ;STORE IT + ASR A + ASR A + ASR A ;SHIFT IN NEXT OCTAL DIGIT + BIC #160000,A ;MASK OFF SIGN BITS + BNE TYPOC1 +TYPOC2: MOV #DNTTYP,E + MOVB E,-(D) ;FILL IN REST OF BUFFER +TYPOC3: CMP #NUMBUF,D ;END TEST + BNE TYPOC2 + JSR 5,TYPE +NUMBUF: 0 ;MAX IS 7 CHARACTERS (-XXXXX.) + 0 + 0 + 0 + RTS 5 + +TYPDEC: MOV #NUMBUF+7,D + MOVB #'.,-(D) + MOV A,-(SP) + BPL TYPDE1 + NEG A +TYPDE1: + MOV A,SCRTCH ;DIVIDEND +TYPDE2: DIVIDE SCRTCH,#12,SCRTCH,E + ADD #'0,E ;ABS REMAINDER + MOVB E,-(D) + TST SCRTCH ;QUOTIENT + BNE TYPDE2 + MOV (SP)+,A + BPL TYPOC3 + MOVB #'-,-(D) + BR TYPOC3 + ;INSTRUCTION INPUT (IN...) AND OUTPUT (EX...) ROUTINES +; A UNKNOWN VALUE ARG TO EXINST; ALSO A SCRATCH REGISTER +; B FIRST SYMBOL WORD FROM INSN SYMBOL TABLE (RADIX-50) +; C SECOND SYMBOL WORD +; D INDEX TO MASKS AND SERVICE ROUTINES TABLES +; E INSN VALUE TABLE POINTER +; F INSN SYMBOL TABLE POINTER + +;INPUT THE INSN WHOSE SYMBOL IS IN R50SYL+0,+2 + +ININST: CLR D ;INITIALIZE POINTERS + MOV #INVALS,E + MOV #INSYMS,F + CLR INBYTE +ININ1: JSR PC,INNEXT + BR ININ3 ;NO SUCH INSN + TST (E)+ + CMP R50SYL,B + BNE ININ1 ;FIRST SYMBOL WORDS UNEQUAL + CMP R50SYL+2,C + BEQ ININ2 ;FOUND + TST #0 +INBYTE=.-2 ;NONZERO IF THIS INSN HAS A BYTE MODE + BEQ ININ1 + CMP R50SYL+2,#2*50*50 ;RADIX-50 B FOR BYTE MODE + BNE ININ1 + BIS #100000,VAL ;INSN IS IN BYTE MODE +ININ2: ADD -(E),VAL ;PICK UP VALUE + CLR LENTYI + JMP @ININ4(D) ;DISPATCH TO SERVICE ROUTINE + +ININ3: JMP EVALS3 ;NO SUCH INSN + +ININ4: INHALT ;INSN INPUT DISPATCH TABLE + INRTS +.IIF NZ M1145,INEMT ;FOR SPL + INCL +.IIF NZ M1140+M1145,INEMT ;FOR MARK + INJMP + INBR + INEMT ;FOR EMT, TRAP +.IIF NZ FPP,INASH +.IIF NZ FPP,INSTF +.IIF NZ M1140+M1145,INSOB + INJSR +.IIF NZ M1140+M1145,INASH + INADD + ;OUTPUT THE INSN WHOSE VALUE IS IN A + +EXINST: MOV A,EXIN2 + CLR D ;INITIALIZE POINTERS + MOV #INVALS,E + MOV #INSYMS,F + CLR INBYTE +EXIN1: JSR PC,INNEXT + BR EXIN4 ;NO SUCH INSN + MOV #0,A +EXIN2=.-2 ;SAVED ARGUMENT VALUE + BIC MASKS(D),A ;CLEAR NON-OP-CODE BITS + CMP (E)+,A + BEQ EXIN3 ;FOUND + TST INBYTE + BEQ EXIN1 ;NOT A BYTE MODE INSN + BIC #100000,A + CMP -2(E),A + BNE EXIN1 ;KEEP LOOKING + MOV #2*50*50,C ;RADIX-50 B FOR BYTE MODE +EXIN3: MOV D,-(SP) ;SAVE DISPATCH INDEX + MOV B,AINST + MOV C,AINST+2 + JSR 5,TYPE50 ;TYPE INSN OP CODE + JSR PC,TYP3SP + MOV EXIN2,A ;RESTORE VALUE + MOV (SP)+,D ;RESTORE DISPATCH INDEX + JMP @EXIN5(D) ;DISPATCH TO SERVICE ROUTINE + +EXIN4: ADD #2,(SP) ;NO SUCH INSN + RTS PC ;SKIP-RETURN + +EXIN5: EXHALT ;INSN OUTPUT DISPATCH TABLE + EXRTS +.IIF NZ M1145,EXEMT ;FOR SPL + EXCL +.IIF NZ M1140+M1145,EXEMT ;FOR MARK + EXJMP + EXBR + EXEMT ;FOR EMT, TRAP +.IIF NZ FPP,EXASH +.IIF NZ FPP,EXSTF +.IIF NZ M1140+M1145,EXSOB + EXJSR +.IIF NZ M1140+M1145,EXASH + EXADD + ;PICK UP NEXT INSN FROM INSN TABLES, FOR ININST OR EXINST +;THIS ROUTINE UPDATES D & F, BUT CALLING ROUTINE MUST DO E + +INNEX0: ADD (F)+,PC ;GOES TO INNEX1, INNEX2 OR INNEX5 +INNEX1: TST (D)+ ;UPDATE MASK AND DISPATCH INDEX + CLR INBYTE ;RESET BYTE MODE FLAG + BR INNEXT + +INNEX2: INC INBYTE ;NEXT INSN(S) HAVE A BYTE MODE +INNEXT: TSTB 1(F) ;ENTRY POINT + BEQ INNEX0 ;UPDATE POINTERS, FLAGS + MOV (F)+,B ;FIRST SYMBOL WORD + CLR C + TST (F) + BPL INNEX4 ;BR IF SYMBOL IS ONLY 1 WORD LONG + MOV (F)+,C ;SECOND SYMBOL WORD + BIC #100000,C ;CLEAR SECOND-WORD FLAG +.IFNZ M40FPU+FPP + ROR C + BCC INNEX3 + BIS #40000,C ;FDIV, STEXP & LDEXP NEED HIGH BIT ON +INNEX3: ASL C +.ENDC +INNEX4: ADD #2,(SP) ;SKIP-RETURN IF HAVE INSN +INNEX5: RTS PC ;NO SKIP IF AT END OF INSNS + +;IN INSYMS TABLE, +;INNEX1-INNEX1 => UPDATE MASK & DISPATCH LOCATION INDEX +;INNEX2-INNEX1 => SET BYTE MODE FLAG FOR NEXT INSNS +;INNEX5-INNEX1 => END OF SYMBOL TABLE + +MASKS: 0 ;ONES IN NON-OP-CODE BITS + 7 +.IIF NZ M1145,7 + 17 +.IIF NZ M1140+M1145,77 + 77 + 377 + 377 +.IIF NZ FPP,377 +.IIF NZ FPP,377 +.IIF NZ M1140+M1145,777 + 777 +.IIF NZ M1140+M1145,777 + 7777 + ;INSN INPUT SERVICE ROUTINES + +INRTS: JSR PC,REEVAL ;GET A GENERAL REGISTER +;REGINF NOT TESTED TO ALLOW SINGLE NUMERAL, LIKE RTS 5 + BIT #177770,E + BNE ABORT3 ;INVALID REGISTER NUMBER +INRTS1: ADD E,VAL +INHALT: RTS PC + +.IFNZ FPP+M1140+M1145 +INASH: JSR PC,INSSDD ;GET SOURCE + CMPB #',,@PARSEP + BNE ABORT3 ;COMA MUST BE SEPERATOR + INC PARSEP + JSR PC,REEVAL ;GET REGISTER + TSTB REGINF + BEQ ABORT3 ;NOT A REGISTER + BITB #200,VAL+1 + BEQ .INAS1 ;FPP INSTRUCTION REGS < 4 + BIT #4,E + BNE ABORT3 ;ILLEGAL REGISTER +.INAS1: CMPB #162,VAL+1 + BNE .INAOK ;IS IT A DIVIDE? + BIT #1,E + BNE ABORT3 ;REG MUST BE EVEN +.INAOK: SWAB E + ASR E ;PUT REGISTER IN PROPER FIELD + ASR E + ADD E,VAL + RTS PC +.ENDC + +.IFNZ FPP +INSTF: JSR PC,INRTS + BIT #4,E + BNE ABORT3 ;INVALID FPP REGISTER NUMBER + BR INADD1 +.ENDC + +INJSR: JSR PC,INRTS + BR INADD1 + +INADD: JSR PC,INSSDD +INADD1: JSR PC,INSHOV +INJMP: JMP INSSDD ;WHICH DOES RTS FOR US + +INSHOV: MOVB VAL,E ;SHOVE NEW FIELD IN VAL LEFT 6 BITS + CLRB VAL + SWAB E + ROR E + ROR E + ADD E,VAL + CMPB #',,@PARSEP ;COMMA MUST SEPARATE FIELDS + BNE ABORT3 + INC PARSEP ;PASS OVER COMMA + RTS PC + +.IFNZ M1140+M1145 +INSOB: JSR PC,INRTS + JSR PC,INSHOV + JSR PC,REEVAL + TSTB REGINF + BNE ABORT3 ;NO SOB TO A REGISTER + NEG E + ADD CURADR,E + ASR E + INC E + BIT #177700,E + BEQ INRTS1 ;OK + BR ABORT3 ;OFFSET OUT OF RANGE +.ENDC + INBR: JSR PC,REEVAL + TSTB REGINF + BNE ABORT3 ;NO BR TO A REGISTER + BIT #1,E + BNE ABORT3 ;NO ODD ADDRESS + SUB CURADR,E + ASR E + ADD #200-1,E + BIT #177400,E + BNE ABORT3 ;OFFSET OUT OF RANGE + SUB #200,E + BIC #177400,E + BR INRTS1 + +INEMT: MOV MASKS(D),INEMT1 + JSR PC,REEVAL + TSTB REGINF + BNE ABORT3 ;ARG CANNOT BE REGISTER QUANTITY + MOV #0,D +INEMT1=.-2 ;MASK OF NON-OP-CODE BITS + COM D + BIT D,E + BEQ INRTS1 +ABORT3: JMP DCDERR ;ARG TOO LARGE FOR FIELD + +INCL1: BISB INCL5-1(B),VAL +INCL2: INC PARSEP ;GO TO NEXT CHAR +INCL: CLR A + MOVB @PARSEP,A ;ENTRY POINT, PICK UP CHAR + CMP #40,A + BEQ INCL2 ;IGNORE SPACES + CLR B +INCL3: INC B + CMPB INCL4-1(B),A + BEQ INCL1 ;CHAR MATCHES + BIT #4,B + BEQ INCL3 ;KEEP LOOKING + RTS PC ;GOT TO TERMINATOR CHAR + +INCL4: .BYTE 'C,'V,'Z,'N +INCL5: .BYTE 1,2,4,10 + +;INSN OUTPUT SERVICE ROUTINES + +EXCL: CLR B +EXCL1: INC B + BITB INCL5-1(B),A + BEQ EXCL3 + MOVB INCL4-1(B),EXCL2 + JSR 5,TYPE +EXCL2: 0 +EXCL3: BIT #4,B + BEQ EXCL1 + RTS PC + EXRTS: BIC #177770,A + BISB #1,REGINF +EXRTS1: JSR 5,SYMBL0 +EXHALT: RTS PC ;SAVE A WORD IF MAKE SYMBOL USE PC, NOT F *** + +.IFNZ FPP+M1140+M1145 + +EXASH: JSR PC,EXSSDD ;PRINT SOURCE OPERAND + JSR 5,TYPE + ', + MOV EXIN2,A ;GET INSTRUCTION + BIT #100000,A + BEQ EXAS1 + BIC #400,A ;FPP INSTRUCTIONS HAVE SMALL REG NUMBERS +EXAS1: ROL A + ROL A + SWAB A ;GET THE DESTINATION REGISTER + BR EXRTS ;GO PRINT IT +.ENDC + +.IFNZ FPP +EXSTF: BIC #400,A ;ONLY 2 BITS IN AC FIELD +.ENDC +EXJSR: ROL A + ROL A + SWAB A + JSR PC,EXRTS + BR EXADD1 + +EXADD: ROL A + ROL A + SWAB A + JSR PC,EXSSDD +EXADD1: JSR 5,TYPE + ', +EXJMP: MOV EXIN2,A + JMP EXSSDD ;WHICH DOES RTS FOR US + +.IFNZ M1140+M1145 +EXSOB: ROL A + ROL A + SWAB A + JSR PC,EXRTS + JSR 5,TYPE + ', + MOV EXIN2,B + BIC #177700,B + DEC B + ASL B + MOV CURADR,A + SUB B,A + BR EXBR1 +.ENDC + +EXBR: MOVB A,A ;EXTEND SIGN + INC A + ASL A + ADD CURADR,A +EXBR1: CLRB REGINF + BR EXRTS1 + +EXEMT: MOV MASKS(D),B + COM B + BIC B,A + JSR 5,TYPNUM + RTS PC ;SAVE A WORD IF MAKE TYPNUM USE PC, NOT F *** + ;TYPE LOW 6 BITS OF A AS SOURCE OR DESTINATION FIELD + +EXSSDD: MOV A,F + BIC #177707,A ;ADDRESSING MODE + BIC #177770,F ;REGISTER + ASR A + ASR A + CMP #7,F + BNE EXSD1 + INC A ;REGISTER IS PC +EXSD1: MOVB EXSDM(A),-(SP) ;PICK UP BYTE OF CONTROL BITS + BIT #200,(SP) + BEQ EXSD2 + JSR 5,TYPE + '@ +EXSD2: BIT #100,(SP) + BEQ EXSD3 + JSR 5,TYPE + '# +EXSD3: BIT #60,(SP) + BEQ EXSD7 + ADD #2,LENGTH ;GET NEXT WORD OF INSTRUCTION + MOV LENGTH,A +.IFZ M1145 + ADD WDINC,A + MOV (A),A +.ENDC +.IFNZ M1145 + ADD #WDINC,A + BIT #1,@A + BNE GETERR ;BR IF WORD FLAGGED AS NOT ACCESSIBLE + MOV @(A),A +.ENDC + BIT #40,(SP) + BNE EXSD4 + ADD CURADR,A + ADD LENGTH,A + ADD #2,A +EXSD4: MOV SYMTOL,EXSD6 + BIT #20,(SP) + BNE EXSD5 + CLR SYMTOL ;SYMBOL MUST MATCH EXACTLY +EXSD5: CLRB REGINF + JSR 5,SYMBL0 + MOV #0,SYMTOL +EXSD6=.-4 ;SAVED SYMBOL TYPER'S OFFSET TOLERANCE +EXSD7: BIT #10,(SP) + BEQ EXSD8 + JSR 5,TYPE + '- +EXSD8: BIT #4,(SP) + BEQ EXSD9 + JSR 5,TYPE + '( +EXSD9: BIT #2,(SP) + BEQ EXSD10 + MOV F,A ;REGISTER + BISB #1,REGINF + JSR 5,SYMBL0 +EXSD10: BIT #4,(SP) + BEQ EXSD11 + JSR 5,TYPE + ') +EXSD11: BIT #1,(SP)+ ;FINALLY DONE WITH MAGIC BITS + BEQ EXSD12 + JSR 5,TYPE + '+ +EXSD12: RTS PC + .IFNZ M1145 +GETERR: TSTB 1(A) ;DECODE ERROR AS SLE OR NXM + BEQ NXMRR +SLERR: JSR 5,TYPE + .ASCIZ /SLE/ + .EVEN + JMP DCDERR + +NXMRR: JMP NXMER +.ENDC + +CURADR: 0 ;CURRENT ADDRESS FOR INSTRUCTION TO SEEM LOCATED AT +;( = DOT OR BPT LOCATION) + +;SOURCE OR DESTINATION FIELD CONSISTS OF ... +; <@> <#> <-> <(> <)> <+> +;WHERE EACH FIELD MAY ALSO BE NULL +;FOLLOWING TABLE OF MAGIC BITS CODES OPTIONS FOR EACH ADDRESSING MODE +;200 BIT ON SAYS TYPE AN @, 100 BIT SAYS TYPE A #, ETC. +;BOTH ( AND ) ARE SPECIFIED BY 4 BIT, AND 60 BITS SAY ... +;00 => NULL +;01 => NEXT WORD + CURADR + LENGTH + 2 +;10 => NEXT WORD, WITH OFFSET TOLERANCE = 0 +;11 => NEXT WORD + +EXSDM: .BYTE 002 ;0R R MODE + .BYTE 002 ;07=0R + .BYTE 006 ;1R (R) + .BYTE 006 ;17=1R + .BYTE 007 ;2R (R)+ + .BYTE 160 ;27 #N + .BYTE 207 ;3R @(R)+ + .BYTE 360 ;37 @#A + .BYTE 016 ;4R -(R) + .BYTE 016 ;47=4R + .BYTE 216 ;5R @-(R) + .BYTE 216 ;57=5R + .BYTE 046 ;6R X(R) + .BYTE 020 ;67 A + .BYTE 246 ;7R @X(R) + .BYTE 220 ;77 @A + ;PARSE A TYPED-IN SOURCE OR DESTINATION FIELD, PUTTING RESULT IN +;LOW 6 BITS OF VAL, AND ANY MORE INSN WORDS IN VAL+2 OR +4 + +INSSDD: JSR PC,REEVAL + TST C + BNE INSD1 ;ARG BEFORE @ MUST BE NULL + CMP #'@,A + BNE INSD1 ;TERMINATOR NOT @ + BIS #10,VAL ;@ SEEN, DEFERRED MODE + INC PARSEP + JSR PC,REEVAL +INSD1: TSTB REGINF + BNE MOD0 ;REGISTER MODE, RN, 0R + TST C + BNE INSD2 ;PARSED STRING IS NOT NULL + CMP #'(,A + BEQ INSD3 ;(RN) OR (RN)+ + CMP #'#,A + BNE ABORT1 ;NO SUCH MODE + BIS #27,VAL ;IMMEDIATE MODE, #N, 27 + INC PARSEP + JSR PC,REEVAL + TSTB REGINF + BNE ABORT1 ;NO #RN MODE + JSR PC,INCLEN + BR INSD2A + +INSD2: CMP #'(,A + BEQ INSD4 ;X(RN) OR -(RN) + BIS #67,VAL ;ABSOLUTE MODE, A, 67 + JSR PC,INCLEN + MOV LENTYI,B + TST (B)+ + ADD DOT,B + SUB B,E +INSD2A: MOV E,(D) + RTS PC + +INSD3: INC PARSEP + JSR PC,INREG + CMPB #'+,@PARSEP + BNE MOD1 ;(RN), WHICH SHOULD BE LIKE @RN + BIS #20,VAL ;AUTOINCREMENT MODE, (RN)+, 2R + BR INREGA ;INC PARSEP AND RTS + +MOD1: BIT #10,VAL + BNE MOD7F ;@(RN), WHICH SHOULD BE LIKE @0(RN) + BIS #10,VAL + RTS PC + INSD4: CMP #1,C + BNE MOD6 ;INDEX MODE, X(RN), 6R + MOV PARSEP,C + CMPB #'-,-(C) ;IS THE ONE PARSED CHAR - ? + BNE MOD6 ;NO, THIS ALSO MEANS INDEX MODE + BIS #40,VAL ;AUTODECREMENT MODE, -(RN), 4R + BR MOD6A + +MOD6: JSR PC,INCLEN + MOV E,(D) + BIS #60,VAL +MOD6A: INC PARSEP +INREG: JSR PC,REEVAL ;PARSE A REGISTER VALUE + TSTB REGINF + BEQ ABORT1 ;MUST BE REGISTER + CMP #'),A + BNE ABORT1 ;TERMINATOR MUST BE ) +INREGA: INC PARSEP ;PASS OVER ) (OR + OF (RN)+ MODE) +MOD0: BIT #177770,E + BNE ABORT1 ;INVALID REGISTER NUMBER + BIS E,VAL ;DEPOSIT REGISTER NUMBER + RTS PC + +MOD7F: BIS #70,VAL ;FUDGE @(RN) INTO @0(RN) + JSR PC,INCLEN + CLR (D) + RTS PC + +INCLEN: ADD #2,LENTYI ;INSTRUCTION IS ANOTHER WORD LONG + MOV #VAL,D + ADD LENTYI,D ;MAKE D POINT TO CURRENT WORD + RTS PC + +ABORT1: JMP O.ERR ;FATAL ERROR IN INSSDD + +VAL: 0 ;TYPED-IN INSTRUCTION GETS ASSEMBLED HERE + 0 + 0 +LENTYI: 0 ;LENGTH OF INSTRUCTION IN VAL, -2 BYTES + ;INSN SYMBOL TABLE -- 1ST WORD IS JUST RADIX-50 +;2ND WORD, IF NOT NULL, IS RADIX-50 PLUS 100000, +;UNLESS IT IS V OR XP -- THEN IT IS RADIX-50 PLUS 1 +;LEFT BYTE ZERO INDICATES CONTROL WORD, AS NOTED + +INSYMS: + 031064 ;\HAL\ + 176400 ;\T \+100000 + 107761 ;\WAI\ < 0 OK SINCE AFTER A 2-WD INSN + 176400 ;\T \+100000 + 071651 ;\RTI\ + 007424 ;\BPT\ + 035254 ;\IOT\ + 070533 ;\RES\ + 121140 ;\ET \+100000 +.IFNZ M1140+M1145 + 071664 ;\RTT\ +.ENDC + 054750 ;\NOP\ +.IFNZ FPP + 011663 ;\CFC\ + 111300 ;\C \+100000 + 073634 ;\SET\ + 122600 ;\F \+100000 + 073634 ;\SET\ + 134100 ;\I \+100000 + 073634 ;\SET\ + 114400 ;\D \+100000 + 073634 ;\SET\ + 145400 ;\L \+100000 +.ENDC + 0 ;CHANGE TO MASK = 7, RTS SERVICE ROUTINE + 071663 ;\RTS\ +.IFNZ M40FPU + 022654 ;\FAD\ + 114400 ;\D \+100000 + 024215 ;\FSU\ + 106200 ;\B \+100000 + 023635 ;\FMU\ + 145400 ;\L \+100000 + 023051 ;\FDI\ + 104601 ;\V \+ ONLY 1 SINCE ALREADY NEGATIVE +.ENDC +.IFNZ M1145 + 0 ;KEEP MASK = 7, CHANGE TO EMT SERVICE ROUTINE + 074514 ;\SPL\ +.ENDC + 0 ;CHANGE TO MASK = 17, CL SERVICE ROUTINE + 012240 ;\CL \ + 073610 ;\SE \ + 0 ;CHANGE TO MASK = 77, EMT OR JMP SERVICE ROUTINE +.IFNZ M1140+M1145 + 050572 ;\MAR\ + 142300 ;\K \+100000 + 0 ;KEEP MASK = 77, CHANGE TO JMP SERVICE ROUTINE + 051100 ;\MFP\ + 134100 ;\I \+100000 + 052160 ;\MTP\ + 134100 ;\I \+100000 + 075224 ;\SXT\ +.ENDC + .IFNZ M1145 + 051100 ;\MFP\ + 114400 ;\D \+100000 + 052160 ;\MTP\ + 114400 ;\D \+100000 +.ENDC + 040230 ;\JMP\ + 075131 ;\SWA\ + 106200 ;\B \+100000 +.IFNZ FPP + 045646 ;\LDF\ + 163370 ;\PS \+100000 + 074746 ;\STF\ + 163370 ;\PS \+100000 + 074763 ;\STS\ + 176400 ;\T \+100000 + 012262 ;\CLR\ + 122600 ;\F \+100000 + 012262 ;\CLR\ + 114400 ;\D \+100000 + 100014 ;\TST\ < 0 OK SINCE AFTER A 2-WD INSN + 122600 ;\F \+100000 + 100014 ;\TST\ < 0 OK SINCE AFTER A 2-WD INSN + 114400 ;\D \+100000 + 003243 ;\ABS\ + 122600 ;\F \+100000 + 003243 ;\ABS\ + 114400 ;\D \+100000 + 054117 ;\NEG\ + 122600 ;\F \+100000 + 054117 ;\NEG\ + 114400 ;\D \+100000 +.ENDC + INNEX2-INNEX1 ;SET BYTE MODE FLAG + 100014 ;\TST\ FIRST SINCE THE WORD IS NEGATIVE + 012262 ;\CLR\ + 012445 ;\COM\ + 035163 ;\INC\ + 014713 ;\DEC\ + 054117 ;\NEG\ + 003343 ;\ADC\ + 073423 ;\SBC\ + 071352 ;\ROR\ + 071344 ;\ROL\ + 004512 ;\ASR\ + 004504 ;\ASL\ + 0 ;CHANGE TO MASK = 377, BR SERVICE ROUTINE + 007520 ;\BR \ + 007265 ;\BNE\ + 006531 ;\BEQ\ + 006635 ;\BGE\ + 007164 ;\BLT\ + 006654 ;\BGT\ + 007145 ;\BLE\ + 007414 ;\BPL\ + 007221 ;\BMI\ + 006711 ;\BHI\ + 007157 ;\BLO\ + 173300 ;\S \+100000 + 007763 ;\BVC\ + 010003 ;\BVS\ + 006373 ;\BCC\ + 006711 ;\BHI\ + 173300 ;\S \+100000 + 006413 ;\BCS\ + 007157 ;\BLO\ + 0 ;KEEP MASK = 377, CHANGE TO EMT SERVICE ROUTINE + 020534 ;\EMT\ + 077721 ;\TRA\ + 162000 ;\P \+100000 + .IFNZ FPP + 0 ;KEEP MASK = 377, CHANGE TO ASH SERVICE ROUTINE + 052224 ;\MUL\ + 122600 ;\F \+100000 + 052224 ;\MUL\ + 114400 ;\D \+100000 + 051634 ;\MOD\ + 122600 ;\F \+100000 + 051634 ;\MOD\ + 114400 ;\D \+100000 + 003344 ;\ADD\ + 122600 ;\F \+100000 + 003344 ;\ADD\ + 114400 ;\D \+100000 + 045646 ;\LDF\ + 045644 ;\LDD\ + 075012 ;\SUB\ + 122600 ;\F \+100000 + 075012 ;\SUB\ + 114400 ;\D \+100000 + 012330 ;\CMP\ + 122600 ;\F \+100000 + 012330 ;\CMP\ + 114400 ;\D \+100000 + 015176 ;\DIV\ + 122600 ;\F \+100000 + 015176 ;\DIV\ + 114400 ;\D \+100000 + 045645 ;\LDE\ + 114201 ;\XP \+ ONLY 1 SINCE ALREADY NEGATIVE + 045643 ;\LDC\ + 134460 ;\IF \+100000 + 045643 ;\LDC\ + 134340 ;\ID \+100000 + 045643 ;\LDC\ + 145760 ;\LF \+100000 + 045643 ;\LDC\ + 145640 ;\LD \+100000 + 045643 ;\LDC\ + 114760 ;\DF \+100000 + 045643 ;\LDC\ + 123040 ;\FD \+100000 + 0 ;KEEP MASK 377, CHANGE TO STF SERVICE ROUTINE + 074746 ;\STF\ + 074744 ;\STD\ + 074745 ;\STE\ + 114201 ;\XP \+ ONLY 1 SINCE ALREADY NEGATIVE + 074743 ;\STC\ + 123350 ;\FI \+100000 + 074743 ;\STC\ + 123540 ;\FL \+100000 + 074743 ;\STC\ + 115150 ;\DI \+100000 + 074743 ;\STC\ + 115340 ;\DL \+100000 + 074743 ;\STC\ + 123040 ;\FD \+100000 + 074743 ;\STC\ + 114760 ;\DF \+100000 +.ENDC + 0 ;CHANGE TO MASK = 777, SOB OR JSR SERVICE ROUTINE +.IFNZ M1140+M1145 + 074432 ;\SOB\ + 0 ;KEEP MASK = 777, CHANGE TO JSR SERVICE ROUTINE + 114152 ;\XOR\ OK SINCE AFTER 0 +.ENDC + 040612 ;\JSR\ +.IFNZ M1140+M1145 + 0 ;KEEP MASK 777,CHANGE TO ASH SERVICE ROUTINE + 052224 ;\MUL\ + 015176 ;\DIV\ + 004500 ;\ASH\ + 004500 ;\ASH\ + 111300 ;\C \+100000 +.ENDC + 0 ;CHANGE TO MASK = 7777, ADD SERVICE ROUTINE + 003344 ;\ADD\ + 075012 ;\SUB\ + INNEX2-INNEX1 ;SET BYTE MODE FLAG + 051656 ;\MOV\ + 012330 ;\CMP\ + 006774 ;\BIT\ + 006753 ;\BIC\ + 006773 ;\BIS\ + INNEX5-INNEX1 ;END OF SYMBOL TABLE + ;INSN VALUE TABLE + +INVALS: 0 ;HALT + 1 ;WAIT + 2 ;RTI + 3 ;BPT + 4 ;IOT + 5 ;RESET +.IFNZ M1140+M1145 + 6 ;RTT +.ENDC + 240 ;NOP +.IFNZ FPP + 170000 ;CFCC + 170001 ;SETF + 170002 ;SETI + 170011 ;SETD + 170012 ;SETL +.ENDC + + 200 ;RTS +.IFNZ M40FPU + 75000 ;FADD + 75010 ;FSUB + 75020 ;FMUL + 75030 ;FDIV +.ENDC + +.IFNZ M1145 + 230 ;SPL +.ENDC + + 240 ;CL + 260 ;SE + +.IFNZ M1140+M1145 + 6400 ;MARK + 6500 ;MFPI + 6600 ;MTPI + 6700 ;SXT +.ENDC +.IFNZ M1145 + 106500 ;MFPD + 106600 ;MTPD +.ENDC + 100 ;JMP + 300 ;SWAB + .IFNZ FPP + 170100 ;LDFPS + 170200 ;STFPS + 170300 ;STST + 170400 ;CLRF + 170400 ;CLRD + 170500 ;TSTF + 170500 ;TSTD + 170600 ;ABSF + 170600 ;ABSD + 170700 ;NEGF + 170700 ;NEGD +.ENDC + 5700 ;TST(B) + 5000 ;CLR(B) + 5100 ;COM(B) + 5200 ;INC(B) + 5300 ;DEC(B) + 5400 ;NEG(B) + 5500 ;ADC(B) + 5600 ;SBC(B) + 6000 ;ROR(B) + 6100 ;ROL(B) + 6200 ;ASR(B) + 6300 ;ASL(B) + + 400 ;BR + 1000 ;BNE + 1400 ;BEQ + 2000 ;BGE + 2400 ;BLT + 3000 ;BGT + 3400 ;BLE + 100000 ;BPL + 100400 ;BMI + 101000 ;BHI + 101400 ;BLOS + 102000 ;BVC + 102400 ;BVS + 103000 ;BCC + 103000 ;BHIS + 103400 ;BCS + 103400 ;BLO + 104000 ;EMT + 104400 ;TRAP + .IFNZ FPP + 171000 ;MULF + 171000 ;MULD + 171400 ;MODF + 171400 ;MODD + 172000 ;ADDF + 172000 ;ADDD + 172400 ;LDF + 172400 ;LDD + 173000 ;SUBF + 173000 ;SUBD + 173400 ;CMPF + 173400 ;CMPD + 174400 ;DIVF + 174400 ;DIVD + 176400 ;LDEXP + 177000 ;LDCIF + 177000 ;LDCID + 177000 ;LDCLF + 177000 ;LDCLD + 177400 ;LDCDF + 177400 ;LDCFD + 174000 ;STF + 174000 ;STD + 175000 ;STEXP + 175400 ;STCFI + 175400 ;STCFL + 175400 ;STCDI + 175400 ;STCDL + 176000 ;STCFD + 176000 ;STCDF +.ENDC + +.IFNZ M1140+M1145 + 77000 ;SOB + 74000 ;XOR +.ENDC + 4000 ;JSR +.IFNZ M1140+M1145 + 70000 ;MUL + 71000 ;DIV + 72000 ;ASH + 73000 ;ASHC +.ENDC + + 60000 ;ADD + 160000 ;SUB + 10000 ;MOV(B) + 20000 ;CMP(B) + 30000 ;BIT(B) + 40000 ;BIC(B) + 50000 ;BIS(B) + SYMBAD: MOVB REGFLG,REGINF + JSR F,SYMBOL + CLRB REGINF + RTS F + +;# IS IN A +SYMBL0: MOV A,ADR2 ;ENTRY FROM INSN DECODER, SO UPDATE ADDRESS + MOVB REGINF,ADR2F +SYMBOL: TSTB TEMPAF ;NORMAL ENTRY TO TYPE A SYMBOL + BNE SYMABS ;TYPE ADDRESSES AS ABSOLUTE +SYMBL2: MOV A,SAVSYM + CLR C + CLR AINST + MOV #O.BSYM,B + CLR D +SYMLOP: ASL D + BNE SYMBL1 + TST -(B) + MOV B,E ;E CONTAINS ADDRSS + TST -(B) + INC D +SYMBL1: SUB #6,B + MOV #0,A ;GET BACK INITIAL ARG +SAVSYM=.-2 + CMP B,O.SYME + BLO SYMLPE + SUB 4(B),A + BLO SYMLOP + CMP A,#200 ;SHOULD MAYBE BE 300 OR 400, AND INFINITE IF $S TYPED *** +SYMTOL=.-2 ;HOW CLOSE SYMBOL MUST MATCH TO GET TYPED SYM+OFFSET + BHI SYMLOP + CMP C,4(B) ;FINDING LARGEST SYMBOL NOT > # + BHI SYMLOP + BIT D,-2(E) + BNE SYMLOP ;HALF KILLED + TSTB REGINF ;SYMBOL'S REG FLAG MUST BE SAME AS VALUE'S + BNE SYMBL3 + BIT D,(E) + BNE SYMLOP + BR SYMBL4 +SYMBL3: BIT D,(E) + BEQ SYMLOP +SYMBL4: MOV 4(B),C ;REPLACE OLD LARGEST + MOV (B),AINST + MOV 2(B),AINST+2 + BR SYMLOP + +SYMLPE: SUB C,A ;WANT TO TYPE FOO + NUMBER + MOV A,-(SP) ;SAVE NUMBER + TST AINST ;IF ZERO NO SYMBOL FOUND + BEQ .SYMPE + JSR 5,TYPE50 + TST (SP) + BNE SYP + TST (SP)+ + RTS 5 + +SYP: JSR 5,TYPE + .ASCIZ /+/ + .EVEN +SYMPE1: MOV (SP)+,A + JMP TYPNUM + +SYMABS: MOV A,-(SP) +.SYMPE: TSTB REGINF + BEQ SYMPE1 + JSR 5,TYPE + .ASCIZ /%/ + .EVEN + BR SYMPE1 + CRLF: JSR 5,TYPE + .BYTE 15 + .BYTE 12 + .BYTE 177 + .BYTE 177 + .BYTE 177 +.IFNZ KL11 + .BYTE 177 + .BYTE 177 + .BYTE 177 ;6 NULLS FOR TIMING +.ENDC + .BYTE 0 + .EVEN + RTS PC + +O.SYLL: BIC #1,DOTFLG ;MAKE DOTFLG AGREE WITH REGFLG + ADD REGFLG,DOTFLG + MOV #O.BSYM,B ;LOOK UP SYMBOL + CLR D +O.SLL2: ASL D + BNE O.SLL3 + TST -(B) + MOV B,O.FLGS + TST -(B) ;SKIP OVER HALF KILLED FLAGS BY -2 + INC D +O.SLL3: SUB #6,B + CMP B,O.SYME + BLO O.SLL1 + CMP (B),O.SYL + BNE O.SLL2 + CMP 2(B),O.SYL+2 + BNE O.SLL2 + MOV #1,C + MOV 4(B),E ;VALUE TO E + MOV D,O.BIT + RTS PC +O.SLL1: CLR O.BIT + RTS PC + +SAVDEC: 0 ;DECIMAL NUMBER BEING ACCUMULATED +O.FLGS: 0 +O.BIT: 0 + ;THIS ROUTINE TAKES CHAR FROM TTY AND STORES IT IN BUFFER. HANDLES +;RUBOUT, QUOTE CHARACTERS (&,",') AND SETS DONEF WHEN A COMMAND CHAR +;OR ANYTHING FOLLOWING ALTMODE(S) IS READ. CONVERTS LOWER CASE TO UPPER. +;IN MAY BE CALLED WHENEVER USER MIGHT BE TYPING AND RUG NOT LISTENING. +;ONLY NON-QUOTABLE CHARS: NULL (0), RUBOUT (177), AND ALTMODE (175) BECOMES ESCAPE (33) + +INCHK: TSTB O.RCSR ;CHECK FOR TTY INPUT + BPL INCHKR + JSR PC,READCH ;ITS THERE SO GET IT + MOVB A,@TNPNTR ;PUT IT IN BUFFER + CMP TNPNTR,#TBUFFE-1 + BHIS INCK2 + INC TNPNTR +INCK2: CLRB @TNPNTR +INCHKR: RTS PC ;NO INPUT + +IN: MOV B,-(SP) + MOV #QUOTFL,B + JSR PC,TYPCHS + TSTB A + BEQ INRET ;DON'T STORE NULLS + CMP #177,A + BEQ RUBOUT + CMP #175,A + BNE NOT175 + MOV #33,A ;ALTMODE CONVERTED TO ESCAPE +NOT175: TST (B) ;QUOTE MODE? + BEQ NOTQT + SUB #401,(B) ;DECREMENT BOTH BYTES OF QUOTFL + TSTB (B) ;IS RIGHT BYTE ZERO YET (GOT ENOUGH CHARS?) + BNE STORE ;NO + CLR (B) ;FINISHED, CLEAR FLAG + BR STORE + +NOTQT: MOV #QTBL,C ;TABLE OF CHARS CAUSING QUOTE MODE (&,",') +NOTQTL: TSTB (C) + BEQ NOTQ ;DONE SEARCHING TABLE + CMPB A,(C)+ + BNE NOTQTL + ADD #177400-QTBL,C ;LOADS C WITH -1,,N, WHERE N = + ;NUMBER OF CHARS TO FOLLOW + MOV C,(B) ;PLACE IT IN QUOTFL +NOTQ: CMP #140,A + BHIS CHKALT ;NOT LOWER CASE + CMP #172,A + BLO CHKALT ;TOO BIG FOR LETTER + SUB #40,A ;CONVERT TO UPPER CASE +CHKALT: CMP #33,A ;ALT NOT A COMMAND, + BEQ ESCAPE ;HANDLED ON THIS LEVEL INSTEAD + TSTB ALTF ;IS THIS A CHAR FOLLOWING ALTMODE(S)? + BEQ NOTALT + INCB DONEF ;DONE WHEN READ ANY CHAR FOLLOWING ALTMODES +NOTALT: MOV #NOALT,B +NTALTL: TSTB (B) ;SEARCH COMMAND TABLE FOR CHAR + BEQ STORE ;FELL OFF END OF TABLE + CMPB A,(B)+ + BNE NTALTL + INCB DONEF ;GOT CHAR IN TABLE + BR STORE + ESCAPE: INCB ALTF +STORE: CMP INPNTR,#IBUFFE-1 + BHIS INRET ;ALREADY AT END OF BUFFER + MOVB A,@INPNTR ;STORE CHAR + INC INPNTR +INRET: CLRB @INPNTR ;SO STRING ENDED WITH 0 BYTE + MOV (SP)+,B + RTS PC ;A CONTAINS CHAR TO BE ECHOED + +RUBOUT: CMP INPNTR,#IBUFF ;RUBBING PAST BEGINNING? + BLOS INRET1 ;YES, IGNORE AND ECHO BELL + DEC INPNTR + MOVB @INPNTR,A + JSR PC,TYPCH ;ECHO RUBBED CAHR + TST (B) + BEQ RUB1 + ADD #401,(B) ;INCREMENT BOTH BYTES OF QUOTFL + TSTB 1(B) ;IS LEFT BYTE ZERO YET? + BNE INRET + CLR (B) ;RUBBED PAST &, ", OR ' -- CLEAR QUOTFL + BR INRET +RUB1: CMP #33,A + BNE INRET + DECB ALTF ;RUBBED OUT AN ALTMODE + BR INRET +INRET1: JSR F,TYPE + .ASCIZ / ?/ + .EVEN + BR INRET + +QTBL: .BYTE '' ;TABLE OF QUOTING CHARS, TAKING 1, 2, 3 ARGS + .BYTE '" + .BYTE '& + .BYTE 0 + +QUOTFL: 0 ;WHEN SET, LEFT BYTE = -1, RIGHT BYTE = # OF + ;QUOTED CHARS TO FOLLOW SO RUBOUT OR ENOUGH CHARS + ;WILL EXIT FROM QUOTE MODE +ALTF: .BYTE 0 ;INC-ED WHEN ALTMODE READ +DONEF: .BYTE 0 ;INC-ED WHEN CHAR READ FOLLOWING ALTMODE(S), + ;OR CHAR IN NOALT TABLE + +READCH: TSTB O.RCSR + BPL READCH ;WAIT FOR TTY INPUT +READCI: MOVB O.RDB,A ;GET CHAR + CLRB O.RDB ;CLEAR FLAGS + + BIC #177600,A + CMPB #KILCHR,A + BEQ READBK + RTS PC +READBK: MOV #O.UR0,SP + MOV #KILCHR,A + CLRB OPENF + JSR PC,TYPCH + JMP DCDERR + ;TYPE A STRING F POINTS TO AND ENDED BY 0 + +TYPE: MOV A,-(SP) +TYPE1: MOVB (F)+,A + BEQ TYPR + JSR PC,TYPCH + JSR PC,INCHK + BR TYPE1 + +TYPR: TSTB (F)+ ;GET ON EVEN ADDRESS + BIC #1,F + MOV (SP)+,A + RTS F ;SINCE ARGUMENTS FOLLOW CALL, USE F, NOT PC + +;THIS ROUTINE ECHOES ANYTHING TYPED WHILE RUG NOT REALLY +;LISTENING, THEN GETS REST OF COMMAND UNTIL COMMAND CHAR SEEN. + +INPUT: MOV #TBUFF,B + MOV #IBUFF,INPNTR + CLR ALTF ;INITIALIZE IN +INPUT1: MOVB (B)+,A + BEQ INPUT3 ;END OF STRING MARKED WITH ZERO BYTE + JSR PC,IN ;PROCESS CHARS THAT HAVE BEEN STORED + TSTB DONEF + BEQ INPUT1 ;COMMAND NOT FOUND + MOV #TBUFF,A +INPUT2: MOVB (B)+,(A)+ ;PACK DOWN INPUT BUFFER + BNE INPUT2 + DEC A + MOV A,TNPNTR + BR INPUTR + +INPUT3: MOV #TBUFF,TNPNTR ;BUFFER IS NOW EMPTY + CLRB TBUFF +INPUT4: JSR PC,READCH + JSR PC,IN ;GET NEW CHAR + TSTB DONEF + BEQ INPUT4 + +INPUTR: MOV INPNTR,SINPTR ;SAVE RESULTS FOR COMMAND DECODER + MOVB ALTF,SALTF + RTS PC ;BUT DON'T CALL "IN" UNTIL IBUFF ALL PROCESSED + +TNPNTR: TBUFF +INPNTR: IBUFF ;POINTER INTO IBUFF +IBUFF: .BLKW 30 ;BYTES ARE SUCCESSIVE CHARACTERS TYPED IN +IBUFFE==. +TBUFF: 0 + .BLKW 30-1 +TBUFFE==. + ;TYPE CHAR IN A, MAKE CONTROL CHARS ^CHAR, +;ALTMODE BECOMES $, TABS ARE 3 SPACES + +GET1UC: MOVB TBUFF,A ;SEE IF ANY IN BUFFER + BEQ GTUC2 + MOV B,-(SP) + MOV #TBUFF-1,B ;SHIFT BUFFER DOWN +GTUC1: CMPB (B)+,(B)+ + MOVB (B),-(B) + BNE GTUC1 + MOV B,TNPNTR + MOV (SP)+,B + BR GTUC3 +GTUC2: JSR PC,READCH +GTUC3: CMP #140,A + BGE TYPCHS + CMP A,#173 + BGE TYPCHS + SUB #40,A +TYPCHS: CMP #12,A ;ENTRY HERE SUPPRESSES TYPING OF CR AND LF + BEQ TYPCH5 + CMP #15,A + BEQ TYPCH5 +TYPCH: MOV A,-(SP) +TYPCHW: TSTB O.TCSR ;WAIT FOR TTO + BPL TYPCHW + BIC #200,A ;TAKE OUT 200 BIT (PARITY) + CMPB #7,A + BEQ TYPCH3 ;BELL, DON'T CONVERT TO ^G + CMPB #12,A + BEQ TYPCH3 ;LF, DON'T CONVERT TO ^J + CMPB #15,A + BEQ TYPCH3 ;CR, DON'T CONVERT TO ^M + CMPB #DNTTYP,A + BEQ TYPCH4 ;CHAR CODE TO SUPPRESS + CMPB #11,A + BNE TYPCH1 + JSR PC,TYP3SP ;TAB BECOMES 3 SPACES + BR TYPCH4 + +TYPCH1: CMPB #33,A + BEQ TYPCH2 + CMPB #175,A + BNE TYPC2A ;ESCAPE BECOME ALTMOE ALSO +TYPCH2: MOV #'$,A ;ALTMODE BECOMES $ +TYPC2A: CMPB #40,A + BLOS TYPCH3 + MOV #'^,O.TDB ;CONTROL CHAR + BIS #100,A + JSR PC,TYPCH + BR TYPCH4 + +TYPCH3: MOV A,O.TDB +TYPCH4: MOV (SP)+,A +TYPCH5: RTS PC + +TYP3SP: JSR 5,TYPE ;TYPE 3 SPACES + .ASCIZ / / + .EVEN + RTS PC + ;RADDIX-50 CODE +;R-50 CHAR ASCII +;0 BLANK DNTTYP OR 40 +;1-32 A-Z 101-132 +;33 $ 44 +;34 . 56 +;35 % 45 +;36-47 0-9 60-71 + +R50TAB: +BLANK: .BYTE DNTTYP ;SPACE OR DNTTYP + .BYTE 'A,'B,'C,'D,'E,'F,'G,'H,'I,'J,'K,'L,'M + .BYTE 'N,'O,'P,'Q,'R,'S,'T,'U,'V,'W,'X,'Y,'Z + .BYTE '$,'.,'% + .BYTE '0,'1,'2,'3,'4,'5,'6,'7,'8,'9 + +;CONVERT ASCII CHAR IN A TO RADIX-50 +;CLOBBERS B BUT SETS N IF NOT RADIX-50 +ASCR50: CLR B +ASCR51: INC B ;WON'T MATCH WITH BLANK + CMPB R50TAB(B),A + BEQ ASCR52 ;FOUND CHAR + CMP #47,B + BNE ASCR51 ;KEEP LOOKING + NEG B ;NOT RADIX-50, RETURN NEGATIVE VALUE +ASCR52: MOV B,A + RTS PC + +;TYPES AINST AND AINST+2, WHICH ARE RADIX-50 +TYPE50: MOVB #DNTTYP,BLANK ;ZEROS BECOME DNTTYP +TYP50A: MOV #BUFF,D + MOV AINST,B + JSR 5,UNPACK + MOV AINST+2,B + BEQ TYP50B + JSR 5,UNPACK +TYP50B: CLRB (D)+ + INC D + BIC #1,D + MOV #205,(D) ;205 IS RTS F -- MAKE IT RTS PC? *** + JSR 5,TYPE + +BUFF: 0 ;WHEN MAXIMALLY FULL, HAS 6 BYTES OF DATA, + 0 ;ONE ZERO BYTE, ONE WASTED BYTE, AND + 0 ;RTS 5 + 0 + 0 + +AINST: 0 ;ARG TO TYPE50, USUALLY RADIX-50 FOR DECODED INSN + 0 + ;THIS ROUTINE CONVERTS RAD50 TO ASCII +;NUMB GIVEN AND RETURNED IN A + +FIFASC: TST A ;BUM -- CAN USE R50TAB *** + BNE FIFNO + MOVB BLANK,A ;EITHER SPACE OR DNTTYP + BR NUTHNG + +FIFNO: CMP #33,A + BLT NUMB + BEQ DOLR + ADD #56,A ;LETTER, 57+11+11=101 +NUMB: ADD #11,A ;PERIOD AND NUMBERS ARE +22 +DOLR: ADD #11,A ;DOLLAR SIGN (ALT MODE) +NUTHNG: RTS 5 + +;THIS ROUTINE TAKES THREE CHARS IN B +;RETURNS 3 ASCII, AND DEPOSITS WHERE D POINTS + +UNPACK: MOV #3100,C + JSR 5,SUBLOP + MOVB A,(D)+ + MOV #50,C + JSR 5,SUBLOP + MOVB A,(D)+ + MOV B,A + JSR 5,FIFASC + MOVB A,(D)+ + RTS 5 + +SUBLOP: CLR A +SUBLP1: CMP C,B + BHI FIFASC + SUB C,B + INC A + BR SUBLP1 + REEVAL: MOV VAL,-(SP) ;RECURSIVE ENTRY POINT TO EVAL + JSR PC,EVAL0 + MOV (SP)+,VAL + RTS PC +;EVAL EVALUATES A STRING POINTED TO BY PARSEP, INCLUDING +;NUMBERS, SYMBOLS, QUOTED CHARS, SPACE=+, -, * AND ! (DIVIDE). +;IT SETS LENTYI, REGINF, UNDEFS, RETURNS TERMINATOR IN A, +;ARG FLAG (0 IF NO ARG) IN C, AND VALUE IN BOTH E AND VAL+0,+2,+4. +;RADIX-50 OF AN UNDEFINED SYMBOL IS IN R50SYL+0,+2. +;EVAL EITHER RTS PC'S OR ABORTS TO RUG'S TOP LEVEL. + +EVAL: CLR LENTYI + CLR NOINST +EVAL0: CLRB REGINF + CLRB UNDEFS ;UNDEFINED SYMBOL FLAG + CLR ARGFLG + CLR VAL1 + CLR VAL2 + MOV #'+*401,OPER1 ;SET OPER1 AND OPER2 TO + +;AT EVAL1, RUG HAS VAL1 OPER1 VAL2 OPER2 AND IS LOOKING FOR NEXT VALUE, VAL +EVAL1: CLR VAL + CLR DECIMF + CLR NOTNUM + CLR OCTVAL + CLR DECVAL + CLR R50SYL + CLR R50SYL+2 + MOV #R50SYL-2,R50LOC + MOV #3100,R50NUM + MOV PARSEP,SPARSE + MOVB @PARSEP,A ;LOOK AT FIRST CHAR OF SYLLABLE + CMP #'',A + BEQ SQUOT ;SINGLE QUOTE + CMP #'",A + BEQ DQUOT ;DOUBLE QUOTE + CMP #'&,A + BEQ AMPER ;AMPERSAND +EVAL2: MOVB @PARSEP,A + JSR PC,ASCR50 ;CONVERT TO RADIX-50 + BMI EVAL4 ;NOT RADIX-50, END OF SYLLABLE + CMP #35,A ;IS CHAR % IN RADIX-50? + BEQ PERCNT ;YES + JSR PC,INR50 + MOVB @PARSEP,A ;PICK UP CHAR AGAIN + CMP #'.,A + BEQ DCMLPT ;PERIOD MAY BE A DECIMAL POINT + SUB #'0,A + BMI ALPHA ;$ IS SYMBOL CONSTITUENT, LIKE A-Z + CMP #9,A + BLO ALPHA ;A-Z + MOV #OCTVAL,B ;CHAR IS A DIGIT + ASL (B) ;MAYBE THIS AND CHKOP COULD USE C INSTEAD *** + ASL (B) + ASL (B) + ADD A,(B)+ ;+ IS LIKE MOV #DECVAL,B + ASL (B) + ADD (B),A + ASL (B) + ASL (B) + ADD A,(B) +EVAL3: INC PARSEP ;DONE WITH THIS CHAR + BR EVAL2 ;PICK UP NEXT CHAR + +PERCNT: BISB #1,REGINF + BR EVAL3 + +DCMLPT: INC DECIMF + BR EVAL3 + +ALPHA: INC NOTNUM + BR EVAL3 + +OCTVAL: 0 ;ACCUMULATED OCTAL NUMBER +DECVAL: 0 ;DECIMAL, MUST BE AT OCTVAL+2 +OPER1: .BYTE 0 ;FIRST ARITHMETIC OPERATOR +OPER2: .BYTE 0 ;SECOND +PARSEP: 0 ;PARSING POINTER INTO IBUFF +REGINF: .BYTE 0 ;0, OR 1 IF TYPED-IN STRING IS A REGISTER +;REGINF BISB-ED WHEN % READ OR IF O.FLGS SAYS TO, +;AND TURNED OFF WHEN EVAL EXITS IF INSN PARSED +UNDEFS: .BYTE 0 ;NONZERO IF UNDEFINED SYMBOL READ +VAL1: 0 ;TEMPORARY VALUES IN PARSING +VAL2: 0 + + +;ACCUMULATE THE RADIX-50 SYMBOL +INR50: CMP #3100,R50NUM ;ABOUT TO DO FIRST CHAR IN WORD? + BNE INR50A ;NO + TST R50SYL+2 ;ALREADY HAVE 6 CHARS? + BNE INR50B ;YES, IGNORE EXTRA CHARS + ADD #2,R50LOC +INR50A: ADD #3100,@#R50SYL-2 ;ADD 3100, 50, OR 1 * CHAR INTO SYMBOL +R50NUM==.-4 +R50LOC==.-2 + DEC A + BNE INR50A + MOV R50NUM,A ;THIS MAGIC CYCLES THRU 3100, 50, 1, 3100, ... + ASR A + ADD R50NUM,A + ASR A + RORB A + MOVB A,A ;SIGN EXTEND IF R50NUM WAS 1 + ASR A + BIC #174626,A ;LEAVE ONLY BITS IN 3100+50+1 + MOV A,R50NUM +INR50B: RTS PC + +R50SYL: 0 ;TWO WORDS OF RADIX-50 CHARACTERS READ BY EVAL + 0 ;C1 C2 C3 C4 BECOMES C1*50*50+C2*50+C3 IN R50SYL, + ;AND C4*50*50 IN R50SYL+2 +O.SYL==R50SYL + +DQUOT: INC PARSEP ;GO ON TO NEXT CHAR + MOVB @PARSEP,VAL + SWAB VAL +SQUOT: INC PARSEP + MOVB @PARSEP,VAL +SQUOT1: INC PARSEP + BR EVAL5 ;HAVE VALUE + +AMPER: INC PARSEP + MOVB @PARSEP,A + JSR PC,ASCR50 + BMI ABORT2 ;NOT RADIX-50 + JSR PC,INR50 + CMP #3100,R50NUM + BNE AMPER ;HAVEN'T GOT 3 CHARS YET + MOV R50SYL,VAL + BR SQUOT1 + +ABORT2: JMP DCDERR ;FATAL ERROR IN EVAL + EVAL4: CMP #34*50*50,R50SYL ;END OF SYLLABLE + BEQ EVALS ;SYLLABLE IS JUST . + TST #0 +NOTNUM==.-2 ;NONZERO SAYS A-Z OR $ SEEN, SO SYLLABLE IS NOT A NUMBER + BNE EVALS ;DO SYMBOL LOOK-UP + MOV OCTVAL,VAL + TST #0 +DECIMF==.-2 ;NONZERO SAYS . SEEN, SO NUMBER IS DECIMAL + BEQ EVAL5 ;HAVE VALUE + MOV DECVAL,VAL +EVAL5: SUB PARSEP,#0 ;HAVE VALUE OF NEW SYLLABLE +SPARSE==.-2 ;SAVED PARSEP AT START OF SYLLABLE + SUB SPARSE,ARGFLG ;INCREASE ARGFLG IF NON-NULL SYLLABLE + MOVB OPER2,A + JSR PC,CHKOP + JMP @EVAL5A(B) + +EVAL5A: OP2PM ;OPER2 IS A SPACE + OP2PM ;+ + OP2PM ;- + OP2T ;* + OP2D ;! + +OP2T: MLTPLY VAL2,VAL,VAL2 ;VAL2 _ VAL2 * VAL + BR OP2PM2 + +OP2D: DIVIDE VAL2,VAL,VAL2,E ;VAL2 _ VAL2 / VAL + BR OP2PM2 + +OP2PM: CMPB #'-,OPER1 ;OPER2 IS + OR -, SO DO OPER1 + BNE OP2PM1 + NEG VAL2 +OP2PM1: ADD VAL2,VAL1 + MOV VAL,VAL2 + MOVB A,OPER1 +OP2PM2: MOVB @PARSEP,A + JSR PC,CHKOP + BMI EVAL6 ;NOT A KNOWN OPERATOR + BEQ OP2PM3 ;BR IF OP IS ONLY A SPACE + INC ARGFLG ;LEGAL OPERATOR IMPLIES AN ARG +OP2PM3: MOVB A,OPER2 + INC PARSEP + JMP EVAL1 ;GO GET ANOTHER NEW SYLLABLE + +EVAL6: MOVB OPER1,A ;CLEAN UP AND EXIT + JSR PC,CHKOP + JMP @EVAL6A(B) + +EVAL6A: OP1P + OP1P + OP1M +;OPER1 CAN NEVER BE * OR ! + +OP1P: ADD VAL2,VAL1 + BR OP1M1 + +OP1M: SUB VAL2,VAL1 +OP1M1: MOV VAL1,VAL +;IF ININST IS MADE TO RETURN 1ST WORD IN E, AND 2ND AND 3RD IN VAL+2 AND VAL+4, THEN OTHER THINGS +;ARRIVING AT EVAL5 CAN EASILY HAVE VALUE IN E AND A FEW WORDS CAN BE BUMMED OUT *** +EVAL7: MOVB @PARSEP,A ;PICK UP TERMINATOR + MOV #0,C +ARGFLG==.-2 ;ZERO IF NO ARGUMENT +;ARGFLG IS # CHARS PARSED, BUT NOT SPACES OR CHARS IN UNDEFINED SYMBOL + MOV VAL,E + TSTB UNDEFS + BEQ CHKOP3 ;RTS + JMP ECOLON ;UNDEFINED SYMBOL, SO BETTER BE COLON COMMAND + ;EVALUATE SYMBOL +EVALS: JSR PC,O.SYLL ;CAN JUST PUT O.SYLL HERE AFTER ITS CALL IN DEFN GOES AWAY *** + BEQ EVALS2 ;NOT FOUND, MAYBE AN INSTRUCTION + BIT D,@O.FLGS ;TEST FOR REGISTER + BEQ EVALS1 + BISB #1,REGINF ;REGISTER +EVALS1: MOV E,VAL + BR EVAL5 ;HAVE VALUE + +EVALS2: TST #0 +NOINST==.-2 ;NONZERO IF WITHIN AN INSTRUCTION PARSE + BNE EVALS4 ;DON'T PARSE SYLLABLE AS INSTRUCTION + MOV DOT,CURADR + MOV REGINF,-(SP) + MOV VAL1,-(SP) + MOV VAL2,-(SP) + MOV OPER1,-(SP) + INC NOINST + JSR PC,ININST ;ONLY CALL + CLR NOINST + MOV (SP)+,OPER1 + MOV (SP)+,VAL2 + MOV (SP)+,VAL1 + MOV (SP)+,REGINF + JMP EVAL5 ;HAVE VALUE + +EVALS3: TST (SP)+ ;UNDO ININST CALL + MOV (SP)+,OPER1 + MOV (SP)+,VAL2 + MOV (SP)+,VAL1 + MOV (SP)+,REGINF +EVALS4: INCB UNDEFS ;UNDEFINED + BR EVAL6 + + +;CHECK ARITHMETIC OPERATOR IN A +CHKOP: CLR B +CHKOP1: CMPB CHKOPT(B),A + BEQ CHKOP2 ;FOUND IT + INC B + TSTB CHKOPT(B) + BNE CHKOP1 ;NOT FINISHED SEARCHING + NEG B ;NEGATIVE IF NOT A LEGAL OP, +CHKOP2: ASL B ;OTHERWISE A USEFUL INDEX QUANTITY +CHKOP3: RTS PC + +CHKOPT: .BYTE 40,'+,'-,'*,'!,0 + SCRTCH: 0 + +MULT: MOV A,-(SP) ;SCRTCH _ SCRTCH * E + MOV B,-(SP) + CLR A +MULT1: CLC + ROR E + BCC NOAD + ADD SCRTCH,A +NOAD: ASL SCRTCH + TST E + BEQ DIVD2 + BR MULT1 + +SIGNF: 0 +DIVD0: MOV A,-(SP) ;SCRTCH _ SCRTCH / E + MOV B,-(SP) + CLR SIGNF + MOV #1,B + CLR A + TST E + BEQ DIVD2 ;/0 YEILDS 0 + BGT DIVD3 + NEG E + COM SIGNF +DIVD3: TST SCRTCH + BGE DIVD4 + NEG SCRTCH + COM SIGNF +DIVD4: ASL B + ASL E + BPL DIVD4 +SHFTDN: CLC + ROR B + BEQ DIVD5 + ROR E ;CARRY CAN'T BE 1 AT THIS PT. + CMP E,SCRTCH + BHI SHFTDN + ADD B,A + SUB E,SCRTCH + BR SHFTDN + +DIVD5: MOV SCRTCH,E ;ABS VALUE OF REMAINDER + TST SIGNF + BGE DIVD2 + NEG A +DIVD2: MOV A,SCRTCH + MOV (SP)+,B + MOV (SP)+,A + RTS PC + +;ABOVE ARE CRETINOUS MULTIPLY AND DIVIDE ROUTINES FOR EAE-LESS LOSERS +;MAYBE EVENTUALLY I'LL REWRITE THEM +;DIVIDE NEEDS TO BE FAST FOR /13 IN DISK ADDRESS CALCULATIONS + DADRS=30000 +CADRS=1000 +;READ IN COMPLETE BLOCK WITH BEGINNING AND END +;POINTS FUDGED TO MAKE DAR AND WC HAPPY +;TRANSFER CORE TO CORE +;WRITE OUT COMPLETE BLOCK + +;B=%1 DON'T CLOBBER IT + +OUTBLK: MOV ADRSS,A + CLC + ROR A + MOV A,D + BIC #MASK,D + MOV D,OUTDAR +;D HAS DAR ADRESS +;A IS WHAT I WISH IT COULD BE + SUB A,D + MOV B,C + CLC + ROR C + SUB C,D + BIC #MASK,D + MOV D,OUTWC +.IFNZ F.HD + ADD #SPRG,OUTDAR +.ENDC +.IFZ F.HD + MOV OUTDAR,MDSAV + JSR PC,MDCNVT + MOV #SPRG,MDSAV+2 + JSR PC,MDADD + MOV MDSAV,OUTDAR +.ENDC + MOV #5,OUTFN + JSR PC,OUTBD + MOV ADRSS,C + BIC #177000,C + MOV C,D + BIC #177776,C + ADD #CADRS,C + ADD #DADRS,D +TRASF: MOVB (C)+,(D)+ + CMP C,B + BLT TRASF + MOV #3,OUTFN +;FALL INTO OUTBD +OUTBD: +.IFNZ F.HD + JSR 5,FDISK + 0 ;DAE +OUTDAR: 0 + DADRS +OUTWC: 0 +OUTFN: 0 +.ENDC +.IFZ F.HD + JSR 5,MDISK +OUTDAR: 0 + DADRS +OUTWC: 0 +OUTFN: 0 +.ENDC + RTS PC + STBLK: MOV #4,C +SBLK: JSR PC,ACK +STBLK1: JSR PC,XREAD + DECB D + BNE STBLK1 +GTONE: JSR PC,XREAD + MOV #5,C + CLR A + JSR PC,XGWORD + SUB C,WORD + CMP C,WORD + BEQ JMPBLK + MOV WORD,C + JSR PC,XGWORD + MOV WORD,ADRSS + MOV #CADRS,B + ROR WORD + ADC B ;SO WILL BE ODD IF ODD, ETC + +LDDATA: JSR PC,XGWORD + TST C + BGT LDLP + BLT CHECKS + MOVB WORD,(B)+ +CHECKS: INCB A + BNE BAD + RTS PC +LDLP: MOVB WORD,(B)+ + MOVB WORD+1,(B)+ + BR LDDATA +ADRSS: 0 + +JMPBLK: JSR PC,XGWORD + MOV WORD,B + JSR PC,XGWORD + INCB A + BNE BAD + JSR PC,ACKOK + INC A ;SO NONZERO + RTS PC + +BAD: MOV #6,C ;TELL 10 NOT OK + BR SBLK + +ACKOK: MOV #4,C + JMP ACK + PSTRT: MOV #L.READ,F + JSR PC,PBLOCK + TSTB A + BNE L.DUN + JSR PC,OUTBLK + BR PSTRT + +PBLOCK: CLR A + JSR PC,L.READ + CMP D,#EOT + BNE PBLK2 + HALT +PBLK2: DECB D ;CHECK FOR +1 (START OF BLOCK) + BNE PBLOCK + JSR PC,L.READ + + JSR PC,L.GWRD + MOV E,C + SUB #4,C + CMP #2,C + BEQ PJUMP + JSR PC,L.GWRD + MOV E,ADRSS + MOV #CADRS,B + ROR E + ADC B + +PLDATA: JSR PC,L.READ + BGE PLD1 + TSTB A + BNE CKSMER + RTS PC +PLD1: MOVB D,(B)+ + BR PLDATA +CKSMER: JSR 5,TYPE + .ASCIZ /C!/ + .EVEN + HALT + BR PBLOCK + +PJUMP: JSR PC,L.GWRD + JSR PC,L.READ + TSTB A + BNE CKSMER + INC A + MOV E,ADRES + RTS PC + +L.DUN: JSR PC,REINIT + JSR PC,L.LD2 + BR DUN4 + TKS=O.RCSR + TKB=O.RDB + TPS=O.TCSR + TPB=O.TDB + RCSR=LINEAD + RBUF=LINEAD+2 + TSCR=LINEAD+4 + TBUF=LINEAD+6 +;ROUTINES TO GET FILES FROM STRANGE PLACES + +STARTZ: JSR PC,ZZERO +START: MOV #RUGFNT,RELOC +.IFNZ M1145 + MOV #"KI,A ;CHANGE TO KERNAL I MODE + JSR PC,CHMODE +.ENDC +.IFNZ FMH + JSR PC,GETFN ;GET FILE NAME AND DEVICE + BEQ STAR.1 + JMP LOADF ;GET FILE FROM DISK +STAR.1: CMPB #'P,DPODEV + BEQ PSTRT +.IIF NZ TEN11,CLR TEN11S + CMPB #'T,DPODEV +.IFF + JSR PC,GET1UC + CMP #'P,A + BEQ PSTRT +.IIF NZ TEN11,CLR TEN11S + CMP #'T,A +.ENDC + BEQ STARTT +.IFNZ TEN11 + .IIF NZ FMH,CMPB #'M,DPODEV + .IIF Z FMH,CMP #'M,A + BEQ .+6 +.ENDC + JMP O.ERR +.IFNZ TEN11 +TENCNT==200 +TENCHR==TENCNT+4 +TENBUF==TENCHR+4 + MOV #TENCNT,A + CLR (A)+ + CLR (A)+ + CLR (A)+ + CLR (A)+ + MOV #TENBUF,TENPNT + MOV PC,(PC)+ +TEN11S: 0 +.ENDC + STARTT: CLR A + JSR PC,LINEIN + MOV #ABUF,D +.IFNZ TEN11 + MOVB #'N,NCHAR ;INITIALIZE IT + TST TEN11S ;LOADING THROUGH THE 10-11 + BEQ 1$ ;SKIP IT + MOVB #'M,NCHAR ;CHANGE IT TO MLODER. +1$: +.ENDC +.IFNZ FMH + MOV D,E +STAT.1: TSTB (E)+ + BNE STAT.1 + CLRB (E) + MOVB #15,-(E) +.ENDC + JSR PC,SEND ;LOGIN TO PDP-10 + JSR PC,CNSL.1 ;LET USER TYPE FILE NAME +SBLKAG: JSR PC,STBLK1 ;SO DON'T SEND EXTRA 4 +SBLKG2: TSTB A + BNE DUN3 ;MEANS JUMP BLOCK AND FINISHED + JSR PC,OUTBLK ;WRITE OUT ON DISK + JSR PC,STBLK ;ACK WITH A 4, THEN READ ANOTHER BLOCK + BR SBLKG2 +DUN3: MOV B,ADRES + CLR E + JSR F,ACN + 5 + CLR A + JSR PC,XSTBLK ;NOW LOAD SYMBOLS INTO CORE, WITH ACKNOWLEDGES +.IFNZ TEN11 + TST TEN11S + BEQ DUN4 + CLR TENCNT ;NO MORE CHAR +1$: TST TENCHR ;WAIT FOR TO TURN NEGATIVE + BPL 1$ +.ENDC +DUN4: JSR PC,DSTBL + JSR PC,REINIT + JMP O.DCD + +ABUF: .BYTE 32 ;^Z + .ASCII /:LOGIN PDP11ī:/ +NCHAR: .ASCII /NLODERī/ +DPONAM: .ASCIZ /DAZZEL/ ;DEFAULT FILE NAME + .EVEN + .BLKW 6 + SEND: JSR PC,OUT10 ;SEND CONTROL-Z + JSR PC,WAIT10 ;WAIT FOR SYSTEM TO RESPOND + JSR PC,WAIT10 +SEND3: JSR PC,OUT10 ;SEND REST OF BUFFER + TSTB (D) + BNE SEND3 + RTS PC + +OUT10: MOV C,-(P) + MOVB (D)+,C + JSR PC,SENDTC + MOV (P)+,C + RTS PC + + .IFNZ FPP +;QUICK HACK TO EXAMINE FPP AC CONTENTS -- SHOULD BE REWRITTEN OR REPLACED *** +FPPACS: TST C ;TYPE AN FPP AC + BEQ FPPERR ;NO ARG + CMP #6,F + BLE FPPERR ;BAD ARG + BIC #7,FPPAC + BIS F,FPPAC ;SET LDD TO GET FROM FPP REGISTER + STFPS @#FPPST + SETD ;SELECT DOUBLE PRECISION + STD 0,@#FPPSV0 +FPPAC: LDD A,A ;THIS IS MODIFIED BY CODE ABOVE + STD 0,@#FPPVAL + LDD @#FPPSV0,0 + LDFPS #0 ;RESTORE STATUS +FPPST==.-2 + JSR PC,TYP3SP + MOV FPPVAL,A + JSR 5,TYPNUM + JSR PC,TYP3SP + MOV FPPVAL+2,A + JSR 5,TYPNUM + JSR PC,TYP3SP + MOV FPPVAL+4,A + JSR 5,TYPNUM + JSR PC,TYP3SP + MOV FPPVAL+6,A + JSR 5,TYPNUM +FPPACR: JMP EQUAL2 + +FPPERR: JMP DCDERR + + +FPPSTR: TST C ;PROCESS N$$F + BEQ FPPERR + CMP #6,F + BLE FPPERR + JSR PC,TYP3SP + BIC #7,FSTAC + BIS F,FSTAC + STFPS @#FPPST + SETD + STD 0,@#FPPSV0 + CLRF FPPVAL + MOV #FPPVAL,D +.FST1: JSR PC,EVAL + TST C + BEQ .FST2 + MOV E,(D)+ + CMP D,#FPPVAL+10 + BLT .FST1 +.FST2: LDD FPPVAL,A + TSTB F + BEQ .FST3 +FSTAC: STD A,A + LDD FPPSV0,A +.FST3: LDFPS @#FPPST + BR FPPACR + +FPPSV0: .BLKW 4 +FPPVAL: .BLKW 4 +.ENDC +O.LGDR: + +;FOLLOWING COMMANDS PRECEEDED BY ALT + O.GO ; G GO TO ADDRESS K + O.WSCH ; W SEARCH WORD + O.EFF ; E SEARCH EFFECTIVE ADDRESS + O.BKPT ; B BREAKPOINTS + O.PROC ; P PROCEED + SETCMD + SETSMD + SETIMD + SETR50 + SETASC + S1ALTO + S1ALTD + NOTWDS + S1ALTA + S1ALTR + STARTZ ;ZERO CORE AND LOAD + START ;DON'T ZERO CORE BUT LOAD +.IIF NZ FMH, DUMPC ;DUMP IN ABSOLUTE LOADER FORMAT + ZERO ;ZEROS CORE + BEGRUG ;$^D DUMPS CURRRENT RUG ON INVIOLATE COPY + BOOT ;$^U GETS AN INVIOLATE COPY OF RUG +.IFNZ FPP + FPPACS +.ENDC +SSFLAG: 0 ;NEED IT ANYWAY AND HAVE TO KILL A LOCATION HERE +;FOLOWING COMMANDS DON'T NEED ALT + EQUAL ; = PRINTS CURRENT VALUE + COLON ; : DEFINES SYM + SLASH ; / OPEN WORD + BACKSL ; \ OPEN BYTE + BACKAR ; BACKARROW, OPEN FIRST ADDRESS + CRETN ; CARRIAGE RETURN CLOSE + LINEFD ; MODIFY, CLOSE, OPEN NEXT + OLDSEQ ; < RETURN TO OLD SEQUENCE AND OPEN + UPARR ; ^ OPEN PREVIOUS + SETR51 ; ] PRINT CURRENT VAL AS RAD50 CHARS + SETASD ; [ PRINT AS ASCII + HKILL ; ^K HALF KILL +.IIF Z FMH, DUMP ;N^D +.IIF Z FMH, UNSAVE ;N^U +.IIF NZ FMH, DELET ;^Q + SSTP ;^N SINGLE STEP + GOADR ;^A + TAB ;TAB + VERS ;TYPE OUT VERSION # +LENGTH: 0 ;JUST NEED SPACE THERE FOR NOW (!), LENGTH OF INSN IN DOT, -2 BYTES + SETCMD ;CHANGE TO CONSTANTS MODE + SETSMD ;CHANGE TO SYMBOL MODE + SETIMD ;INSTRUCTION MODE + SETR50 ;RADIX-50 MODE + SETASC ;ASCII MODE + S2ALTO ;OCTAL MODE + S2ALTD ;DECIMAL MODE + S2ALTA ;INHIBIT TYPING OUT ADDRESSES SYMBOLICALLY + S2ALTR ;REVERSE ACTION OF $$A + DELTB ;DELETE BREAKPOINT(S) + ZEROAL ;ZERO CORE AND SYMBOL TABLE +.IFNZ M1145 + CHNGMD + KMODE + UMODE +.ENDC +.IFNZ FPP + FPPSTR +.ENDC + +O.LGL=.-O.LGDR ;LGL MUST EQUAL 2X CHLGT ALWAYS + O.LGCH: +;FOLLOWING COMMANDS PRECEEDED BY ALT +ALT: .BYTE 'G ; G + .BYTE 'W ; W + .BYTE 'E ; E + .BYTE 'B ; B + .BYTE 'P ; P + .BYTE 'C + .BYTE 'S + .BYTE 'I + .BYTE '] + .BYTE '[ + .BYTE 'O + .BYTE 'D + .BYTE 'N + .BYTE 'A + .BYTE 'R + .BYTE 'L ;LOAD + .BYTE 12. ; ^L DON'T ZERO CORE +.IIF NZ FMH, .BYTE 'Y ;DUMP + .BYTE 'Z ;ZERO CORE + .BYTE 4 ;^D SAVE RUG + .BYTE 21. ;^U +.IFNZ FPP + .BYTE 'F +.ENDC + .BYTE 0 +N1ALC==.-O.LGCH ;NUMBER OF ONE-ALTMODE COMMANDS +NOALT: .BYTE '=; = + .BYTE ': ; : + .BYTE '/ ; / + .BYTE '\ ; \ + .BYTE '_ ; BACKARROW + .BYTE 15 ; CARRIAGE RETURN + .BYTE 12 ; + .BYTE '< ; < + .BYTE '^ ; ^ + .BYTE '] ; ] + .BYTE '[ ; [ + .BYTE 13 ;^K +.IIF Z FMH, .BYTE 4 ;^D +.IIF Z FMH, .BYTE 25 ;^U +.IIF NZ FMH, .BYTE 17 ;^Q + .BYTE 16 ;^N + .BYTE 1 ;^A CHANGE GO ADRESS + .BYTE 11 ;TAB + .BYTE 26 ;^V + .BYTE 0 +N0ALC==.-O.LGCH-N1ALC ;NUMBER OF ZERO-ALTMODE COMMANDS +TWOALT: .BYTE 'C + .BYTE 'S + .BYTE 'I + .BYTE '] + .BYTE '[ + .BYTE 'O + .BYTE 'D + .BYTE 'A + .BYTE 'R + .BYTE 'B + .BYTE 'Z +.IFNZ M1145 + .BYTE 'M + .BYTE 'K + .BYTE 'U +.ENDC +.IFNZ FPP + .BYTE 'F +.ENDC + .BYTE 0 +O.CLGT=.-O.LGCH ;TABLE LENGTH +.EVEN + CURVAL: 0 ;CURRENT VALUE +COUNT: 0 +O.T: .BYTE 0 ; T-BIT FLAG +O.P: .BYTE 0 ;-1 IF NO PROCEED ALLOWED + ;0-7 IF PCEED ALLOWED + .EVEN +O.CSR1: .BYTE 0 ;SAVE CELL - R C/SR +O.CSR2: .BYTE 0 ;SAVE CELL - T C/SR + .EVEN + .IFNZ FMH + +;THESE ARE THE RUG FILES HANDLEING ROUTINES +;THEY WORK (?) ON LOGO FILE STRUCTURES + +;ROUTINE FOR $Y DUMPS CORE INTO FILE IN ABSOLUTE LODER FORMAT + +BITAB=2000 ;BIT-TABLE GOES HERE +DIRIN=4000 ;READ DIRECTORY INTO HERE +DIROUT=6000 ;WRITE DIRECTORY FROM HERE +ABSBUF=12000 ;ABS FORMATER PUTS STUFF HERE (USES 110000 BYTES) +ABSEND=ABSBUF+102000 ;LEAVE ROOM FOR CKSUM +ROOTBK=46 ;BLOCK NUMBER OF ROOT DIRECTORY + + + +DPNAM: .BLKW 10. +DUMPC: MOV O.SYME,A + MOV #CSTBL,C ;ZERO UNUSED PART FOR SMALLER DUMP + SUB C,A ;COMPUTE WORD COUNT + ASR A +DUMP.1: CLR (C)+ + SOB A,DUMP.1 + JSR PC,FNDFIL ;SEARCH DIRECTORY FOR FILE + BEQ DUMP.3 ;IT DOESN'T EXIST + JSR PC,DELETE ;GET RID OF IT +DUMP.3: JSR PC,WRITE ;WRITE IT +DUMP3A: BIS #200,DPNAM + JSR PC,FINDEN ;WRITE OUT REST OF DIR + JSR PC,WTDIR ;WRITE DIRECTORY + JSR PC,WTBITS ;WRITE BIT TABLE +DUMP.4: JSR PC,SYMINT +DUMP.5: MOV #O.UR0,SP + JSR PC,REINIT + JMP O.DCD +SYMINT: JSR F,SYSDSK ;RELOAD SYMBOL TABLE +.IIF NZ F.HD, 0 + SSTBL + CSTBL + -SSTBUL + 5 + RTS PC + + ;SEARCH DIRECTORIES FOR FILE + + +FNDFIL: JSR PC,DSTBL ;DUMP SYMBOL TABLE + JSR PC,GETFN ;GET THE DRIVE AND FILE NAME + BNE FNDF.2 +FNDF.3: JSR F,TYPE + .ASCIZ /BAD DEVICE/ + .EVEN + BR DUMP.4 +FNDF.2: JSR PC,RDBITS ;READ BIT-TABLE AND ROOT DIR (BLK 46) + MOV #'.,DPNAM ;NAME OF RUGS DIRECTORY + JSR PC,RDDIR + MOV A,-(SP) + MOV B,-(SP) + MOV #DPONAM,A + MOV #DPNAM,B +FNDF.1: MOVB (A)+,(B)+ + BNE FNDF.1 + MOV (SP)+,B + MOV (SP)+,A + JMP FIND.0 ;FIND IT + + ;GETS FILE NAME UP TO 10. CHARS INTO DPONAM +;ALSO SETS UP DRIVE INFO +;SEZ IF NOT DISK DEVICE + +GETFN: JSR PC,TYP3SP + MOV #DPNAM,E + MOV #22,F +GETN.1: JSR PC,GET1UC + CMP #15,A ;CR-RTN IS END OF NAME + BEQ GETN.2 + CMP #12,A + BEQ GETN.2 + CMP #177,A + BEQ GETFN ;RUBOUT CHARACTER + CMPB #':,A ;DEVICE NAME? + BNE GETN.4 + CMP #DPNAM+1,E + BNE GETFN + MOVB DPNAM,#'0 ;DEFAULT DEVICE +DPODEV==.-2 + BR GETFN +GETN.4: MOVB A,(E)+ ;STORE CHAR + SOB F,GETN.1 +GETN.2: JSR PC,CRLF + CLRB (E) + CMP E,#DPNAM + BEQ GETN.5 ;USE DEFAULT NAME + MOV #DPNAM,E + MOV #DPONAM,A +GETN.7: MOVB (E)+,(A)+ + BNE GETN.7 +GETN.5: MOV DPODEV,A + CMPB #'P,A + BEQ GETN.6 + CMPB #'T,A + BEQ GETN.6 +.IFNZ TEN11 + CMPB #'M,A + BEQ GETN.6 +.ENDC +.IIF Z F.HD, BR GTDR.3 + CMPB #'F,A + BNE GTDR.3 + MOV #FXWRT,WCHDSK + RTS PC +GTDR.3: +.IIF Z M.HD, BR FNDF.3 + MOV #MVWRT,WCHDSK + BIC #177600,A + SUB #'0,A + BLT FNDF.3 + CMP #3,A ;DISK 3 IS THE LAST VALID DISK NOW + BLT FNDF.3 + ASH #13.,A + MOV A,WCHPLT + CLZ +GETN.6: RTS PC + ;DELETES FILE BEING POINTED AT AFTER ASKING + +DELETE: JSR F,TYPE + .ASCIZ /FILE EXISTS DELETE?/ + .EVEN +DELE.3: JSR PC,GET1UC + CMPB A,#'Y + BEQ DELE.4 ;HE CHANGED HIS MIND AGAIN +DELE.2: JMP DUMP.4 +DELE.4: JSR PC,CRLF +DELE.1: JSR PC,RDDISC + BEQ GETN.6 ;NO MORE DISCRIPTOR SO RETURN + MOV BLKINC,F ;TURN BLK# INTO BIT TO BE CLEARED + CLR E + DIV #20,E ;WORD NUMBER IN E + MOV #1,A ;BIT NUMBER IN F + ASH F,A + ASL E + BIC A,BITAB+2(E) + BR DELE.1 + + +DELET: JSR PC,FNDFIL ;GET NAME + BEQ DELERR + JSR F,TYPE + .ASCIZ /SURE?/ + .EVEN + JSR PC,DELE.3 ;DELETE IT + JMP DUMP3A +DELERR: JMP LODFER + ;WRITES OUT FILE GIVEN TO IT A BLOCK AT A TIME BY SUBROUTINE +;WRITES DISCRIPTOR WHERE B POINTS +;CLOBERS REGS 2,3,4,5 + +WRIT.0: JSR F,TYPE + .ASCIZ /ENTRY TO LARGE/ + .EVEN + BR DELE.2 + +WRITE: MOV A,-(SP) + CLRB (B)+ + BIC #1,B ;GET TO WORD BOUNDARY + MOV B,-(SP) ;SAVE FOR LEGNTH CALCULATION + CLR (B)+ ;SPACE FOR LEGNTH AND FLAGS + TST NDIRSW + BEQ WRIT.4 + MOV #-1,(B)+ ;VERSION NUMBER + CLR (B)+ ;EOF WORDS + CLR (B)+ + MOV #-1,(B)+ ;DATE AND TIME + MOV #-1,(B)+ +WRIT.4: MOV #DPNAM,D ;PUT NAME IN DISCRIPTOR +WRIT.1: MOVB (D)+,(B)+ + BNE WRIT.1 ;LOAD NAME + DEC B + BISB #200,-1(B) ;LAST CHAR HAS 200 BIT SET + MOV #-1,BLKINC + MOV #-1,OLDINC ;INITIALIZE BLK POINTERS + CLR WTTYP ;FOR WTDISC + CLR #0 +EOFPG=.-2 + CLR #0 +EOFBT=.-2 + JSR PC,GETFIL ;GET BLOCKS OF FILE (A) +WRIT.2: JSR PC,@(SP)+ ;CO-ROUTINE + BEQ WRIT.3 ;NO MORE TO WRITE + JSR PC,WTDISC ;WRITE BLOCK (RO) POINTS AT + ADD #2000,A + BR WRIT.2 +WRIT.3: CLRB (B) ;NEW DIRECTORIES HAVE ODD LEGNTHS + TST NDIRSW + BNE WRIT.5 ;NEW FILES HAVE DATE AND TIME ELSEWHERE + INC B + BIC #1,B ;GET WORD BOUNDARY + MOV #-1,(B)+ + MOV #-1,(B)+ ;FILES END WITH 2 WORDS OF -1 +WRIT.5: MOV B,D + MOV (SP)+,C ;BEGINNING OF ENTRY + MOV (SP)+,A + SUB C,D + TST NDIRSW + BNE WRIT.6 + ASR D ;COMPUTED LEGNTH + BIT #177700,D + BNE WRIT.0 ;LEGNTH TOO LONG + ADD #200,D + MOVB D,(C) ;STORE LEGNTH AND TYPE + RTS PC +WRIT.6: BIT #177400,D + BNE WRIT.0 + BIS #102000,D ;FILE ENTRY TYPE + MOV D,(C) + MOV EOFPG,4(C) + MOV EOFBT,6(C) + INC B ;LENGTH IS ODD, MAYBE + BIC #1,B ;BUT WORD BOUNDARY NEVER IS! + RTS PC + ;GETFIL INITIALIZES ABSDMP AND GIVBLK AND SETS UP CO-ROUTINE LINKAGE + + +GETFIL: CLR FILEND ;FOR SHAKBF + MOV #SPRG,SHKDAR + MOV #ABSBUF+2000,SHKCMA + MOV #-40000,SHKWC + MOV #ABSBUF+2000,ABSDIS ;FOR ABSDMP + JSR PC,SHAKBF ;SET UP BUFFER + MOV (SP),-(SP) ;SET UP CO-ROUTINE LINKAGE + MOV #GETF.1,2(SP) + BR GIVBLK ;RETURN + +GETF.1: ;COMES BACK TO HERE FOR MORE +.IFNZ F.HD + MOV #SPRG+40000,SHKDAR +.IFF +MVAD 40000,SPRGM ;CONVERT TO SPECIAL MOVING DAR +MVADD SPRG,SPRGM,SPRGM + MOV #SPRGM,SHKDAR +.ENDC + MOV #ABSEND-SPRGL-SPRGL+100000,SHKCMA + MOV #-SPRGL+40000,SHKWC + MOV #ABSEND-SPRGL-SPRGL,ABSDIS + JSR PC,SHAKBF + MOV ADRES,F + JSR PC,LSTFRM ;SET UP SPECIAL FRAME + MOV #GETF.2,2(SP) + BR GIVBLK ;RETURN + +;COMES BACK HERE FOR MORE + +GETF.2: MOV #SSTBL,SHKDAR ;DO SYMBOL TABLE NOW + MOV #ABSEND-SSTBUL-SSTBUL,SHKCMA + MOV #-SSTBUL,SHKWC + MOV #ABSEND-SSTBUL-SSTBUL-CSTBL,ABSDIS + JSR PC,SHAKBF + MOV O.SYME,F + JSR PC,LSTFRM + ADD #1777,FILEND ;MAKE SURE LAST BLOCK IS WRITTEN + MOV #GETF.3,2(SP) + BR GIVBLK +GETF.3: MOV (SP)+,(SP) ;DESTROY CO-ROUTINE LINKAGE + SEZ + RTS PC + + + ;CO-ROUTINE PUTS POINTER TO BLOCK IN A +;WHEN IT RUNS OUT IT ASKS GETFIL FOR MORE + + +GIVB.0: MOV (SP)+,A + JSR PC,@(SP)+ ;RETURN TO WRITE +GIVBLK: MOV A,-(SP) + ADD #2000,A ;CHECK IF ANOTHER BLK IS IN BUFFER + CMP A,#0 +FILEND=.-2 + BLOS GIVB.0 + MOV (SP)+,A + JMP @2(SP) ;GO TO GETFIL FOR MORE BLOCKS + ;SETS UP BUFFER, MOVING LEFTOVERS TO BOTTOM AND CRUNCHING +;WHATEVER IS NECESSARY + + +SHAKBF: MOV B,-(SP) + MOV FILEND,D + BIC #1777,D + MOV #ABSBUF,C +SHAK.1: CMP D,FILEND ;GET LEFTOVERS + BHIS SHAK.2 + MOVB (D)+,(C)+ + BR SHAK.1 +SHAK.2: JSR F,SYSDSK +.IIF NZ F.HD, 0 +SHKDAR: 0 +SHKCMA: 0 +SHKWC: 0 + 5 + MOV SHKCMA,B + JSR PC,ABSDMP ;CHANGE TO ABS LODER FORMAT + MOV C,FILEND ;SAVE END OF BUFFER + MOV #ABSBUF,A + MOV (SP)+,B + RTS PC + ;TAKES CORE BETWEEN (B) AND (ABSEND) +;PACKES IT IN ABSOLUTE LODER FORMAT BEGINING AT (C) +;(ABSDIS) IS CROCK SINCE ROOM MUST BE LEFT FOR 6 BYTES BEFORE 1ST FRAME +;A IS CHECKSUM +;B IS POINTER IN CORE +;C IS POINTER IN PACKED CORE +;D IS BYTE COUNT (BEGINNING OF FRAME) +;E IS USED FOR SUMMING CHECKSUM +;F IS SCRATCH + + +ABSDMP: CLR E + CLR ABSEND ;ZERO MAKES SURE LODER WILL STOP +ABSD.1: CMP #ABSEND,B + BLOS ABSDUN ;DO LAST FRAME NOW + TSTB (B)+ ;FIND NON-ZERO BYTE + BEQ ABSD.1 + DEC B +ABSD.2: MOV C,D ;SAVE ADDRESS OF FRAME FOR BC + MOV #1,A + MOVB A,(C)+ + CLRB (C)+ + CMPB (C)+,(C)+ ;SAVE SPACE FOR BC + MOV B,F ;COMPUTE AND STORE ADDRESS + SUB #0,F +ABSDIS=.-2 + MOVB F,(C)+ + ADD F,A + SWAB F + MOVB F,(C)+ +ABSD.3: MOVB -1(C),E ;COMES HERE WHEN FINDS SOME BUT NOT + ADD E,A ;ENOUGH ZEROS +ABSD.4: MOVB (B)+,E + ADD E,A + MOVB E,(C)+ ;STORE BYTE AND UPDATE CKSUM + BNE ABSD.4 + MOV #7,F ;FOUND ZERO CHECK FOR 7 MORE +ABSD.5: CMP #ABSEND,B + BLOS ABSD.6 ;END OF CORE + MOVB (B)+,(C)+ + BNE ABSD.3 ;NOT ENOUGH 0'S CONTINUE FRAME + SOB F,ABSD.5 +ABSD.6: TSTB -(C) ;BACK UP POINTER + BEQ ABSD.6 + INC C ;IT NOW POINTS JUST PAST LAST BYTE +ABSD.7: MOV C,F ;COMPUTE AND STORE BYTE COUNT + SUB D,F + ADD F,A + CMPB (D)+,(D)+ ;D NOW HAS ADD. TO PUT BC + MOVB F,(D)+ + SWAB F + ADD F,A + MOVB F,(D) + NEG A ;COMPUTE AND STORE CHECKSUM + MOVB A,(C)+ + BR ABSD.1 ;GO DO MORE FRAMES + +ABSDUN: RTS PC + + ;SETS UP LAST FRAME IN BUFFER +;F IS ADDRESS FOR FRAME + +LSTFRM: MOVB #1,(C)+ + CLRB (C)+ + MOVB #6,(C)+ + CLRB (C)+ + MOV #7,E ;CHECKSUM + ADD F,E + MOVB F,(C)+ + SWAB F + ADD F,E + MOVB F,(C)+ + NEG E + MOVB E,(C)+ + MOV C,FILEND ;UPDATE END OF BUFFER + RTS PC + ;WRITES DISCRIPTOR AND SENDS BLK OFF TO DISK +;BLKINC AND OLDINC POINT TO DISK BLOCKS +;WTTYP AND WTCNT ARE BYTE FLAGS FOR WRITING THE DISCRIPTORS +;(B) IS WHERE DISCRIPTOR IS PLACED +;IT ALSO FINDS FREE BLOCK TO WRITE ON, CHANGING THE BIT TABLE +;CLOBBERS REGS 3,4,5 + + +WDIS.0: JSR F,TYPE + .ASCIZ /DISK FULL?/ + .EVEN +WDIS00: JMP DUMP.4 + +WTDISC: INC BLKINC + MOV BLKINC,F + CMP F,BITAB + BGE WDIS.0 ;THAT IS AN ILLEGAL BLOCK + CLR E + DIV #20,E ;FIND BIT IN TABLE + MOV #1,D + ASH F,D + ASL E + BIT D,BITAB+2(E) ;SEARCH TABLE FROM BEGINNING + BNE WTDISC + ADD #2000,EOFBT + CMP EOFBT,#20000 + BLT WDIS.9 + CLR EOFBT ;COMPUTE LEGNTH OF FILE + INC EOFPG +WDIS.9: BIS D,BITAB+2(E) ;SET WRITTEN ON BIT + MOV BLKINC,F + SUB OLDINC,F ;COMPUTE DISP FROM LAST BLOCK + TSTB #0 +WTTYP=.-2 +WTCNT=.-1 + BEQ WDIS.1 ;START NEW DISCRIPTOR + DEC F + BNE WDIS.6 ;SKIPPED SOME BLOCKS + INCB WTCNT + BITB #0,WTCNT ;MASK IS 3 OR 6 BITS +WTMASK=.-4 + BNE WDIS.2 ;START MULTIPLE GET DISCRIPTOR + INCB 0(B) ;CHANGE PREVIOUS DISCRIPTOR +WTBACK=.-2 + BR WDIS.5 +WDIS.1: DEC F ;# BLKS TO BE SKIPPED + BNE WDIS.6 ;DO A SKIP DISCRIPTOR +WDIS.2: MOV #100,WTTYP ;SET TYP AND CNT FLAGS + MOV #340,WTMASK ;HALF AS MUCH BECAUSE OF RON +WDIS.3: MOV #-1,WTBACK +WDIS.4: MOVB WTTYP,(B)+ ;WRITE DISCRIPTOR +WDIS.5: MOV BLKINC,#0 ;SAVE BLK # +OLDINC=.-2 +WDISRT: JMP WTBLK ;WRITE IT AND RETURN +WDIS.6: CMP F,#7 ;LARGE OR SMALL SKIP + BGT WDIS.7 + MOV #300,WTTYP ;SMALL SKIP + MOV #370,WTMASK + ASH #3,F + MOV #-1,WTBACK + ADD WTTYP,F +WDIS6A: MOVB F,(B)+ ;WRITE DISCRIPTOR + BR WDIS.5 +WDIS.7: CMP F,#77 ;SKIP OR SET ADDRESS + BGT WDIS.8 + CLR WTTYP ;SKIP AND GET 1 + BR WDIS6A +WDIS.8: MOV #200,WTTYP ;THREE BYTE DISCRIPTOR + MOV #300,WTMASK + MOV #-3,WTBACK + MOVB WTTYP,(B)+ ;WRITE 1ST BYTE + MOVB BLKINC,(B)+ ;2ND BYTE + MOVB BLKINC+1,(B)+ ;LAST BYTE + BR WDIS.5 + ;READS DISC POINTED TO BY C +;LOOKS AT BLKNT FIRST FOR PREVIOUSLY READ DISC +;IF (D) =0 CHECKS FFLAG AND SEZ + + +RDDISC: INC BLKINC + TSTB BLKNT + BEQ RDIS.1 + DECB BLKNT ;STILL BLOCKS LEFT FROM LAST DISCRIPTOR + BR RDSKIQ ;FOUND BLOCK +RDIS.1: TST D + BGT RDIS.3 + TST FFLAG ;NO MORE LEFT + BLE RDIS.2 ;NOT A FILE + ADD #4,C +RDIS.2: MOV C,A ;FOR FINDEN + SEZ + RTS PC ;NO BLOCKS FOUND +RDIS.3: DEC D + MOVB (C)+,E + BEQ RDIS.1 ;NO-OP DISCRIPTOR + MOVB E,#0 +BLKNT=.-2 + BIC #177700,BLKNT ;GET 1ST FIELD + BIC #177477,E ;LEAVE ONLY TYPE FIELD + ASH #-5,E + ADD E,PC + BR RDSKIP + BR RDBNCH ;READ A BUNCH + BR RDSETA + + + MOV BLKNT,E ;SKIP N1 AND GET N2+1 + BICB #70,BLKNT + ASH #-3,E + ADD E,BLKINC ;SKIP SOME + RTS PC + + +RDBNCH: BIT #40,BLKNT + BNE RDIS.1 ;HOLE IN FILE DISCRIPTOR + BR RDSKIQ ;GET A BUNCH DISCRIPTOR + + +RDSKIP: ADD BLKNT,BLKINC ;SKIP N1 AND GET 1 + CLR BLKNT +RDSKIQ: CLZ + RTS PC + + +RDSETA: SUB #2,D + BLT RDSETB ;WHERE'S THE REST OF THIS DISCRIPTOR? + MOVB (C)+,BLKINC + MOVB (C)+,BLKINC+1 ;SET THE BLOCK # + BR RDSKIQ +RDSETB: JSR F,TYPE + .ASCIZ /BAD DISCRIPTOR?/ + .EVEN +RDSETC: JMP WDIS00 + ;FIND ENTRY WITH NAME IN DPNAME ELSE FIND WHERE IT SHOULD GO +;WRITE FROM DIRIN TO DIROUT AS YOU GO +;FIND.0 ENTRY INITIALIZES A NEW DIR SEARCH AND SKIPS HEADER +;USES ENDBLK END OF DIRECTORY +; A START OF CURRENT ENTRY +; B POINTER IN OUTPUT +; C POINTER IN INPUT +; D LENGTH OF CURRENT ENTRY +;CLOBBERS E,F + +FIND10: BIC #177400,D ;LEGNTH IN BYTES + INC D + ASR D + CLR FFLAG ;DATE AND TIME ARE NOW AT BEGINNING OF DISC + TST (C)+ ;SKIP VERSION NUMBER OR DIRID + ROL E + BCC 1$ + ADD #10,C ;SKIP EOF DATE AND TIME +1$: BR FIND11 + +FINDEN: CLR BLKNT ;INIT RDDISC + MOV #-1,BLKINC + BR FIND.7 ;CHECK FOR END OF DIRECTORY +FIND.1: MOV A,C + MOV (C)+,D ;GET LENGTH IN WORDS + MOV D,E ;KLUGE TO FIND IF THIS IS A FILE + TST NDIRSW + BNE FIND10 ;NEW STYLE DIRECTORY + BIC #177700,D + BIC #177400,E + ASH #-7,E + SBC E ;ITS POSITIVE IF FILE ENTRY + MOV E,#0 +FFLAG=.-2 +FIND11: MOV #DPNAM,E +FIND.2: TSTB (E) ;ZERO MEANS IT ENDED + BMI FIND.6 ;IF 200 BIT SET SKIP ALL ENTRIES + BEQ FIND.5 ;ENTRY WOULD BE HERE + MOVB (C),F + BPL FIND.4 ;LAST CHAR IN NAME HAS BIT SET + BIC #200,F + CMPB (E)+,F + BLT FIND.5 ;ENTRY WOULD BE HERE + BGT FIND.6 ;WRITE OUT ENTRY AND CONTINUE SEARCH + TSTB (E) ;LOOK TO SEE IF DPNAM IS DONE ALSO + BNE FIND.6 ;NOPE SO WRITE ENTRY AND CONTINUE + TST FFLAG + BLE FIND3A + SUB #2,D ;FILES END WITH 2 WORDS OF -1 +FIND3A: INC C ;NAMES MATCH +FIND.3: ASL D ;RDDISC WANTS BYTE COUNT + SUB C,D + ADD A,D ;NUMBER OF BYTES LEFT IN ENTRY + CLZ + RTS PC +FIND.4: CMPB (E)+,(C)+ + BEQ FIND.2 ;CONTINUE COMPARE + BGT FIND.6 ;WRITE ENTRY AND CONTINUE +FIND.5: SEZ ;ENTRY WOULD BE HERE + RTS PC +FIND.0: TST NDIRSW + BNE FIND.8 ;NEW STYLE DIRECTORIES + MOV A,ENDBLK + SUB 1776(A),ENDBLK ;COMPUTE ADDRESS OF LAST WORD + ADD #2000,ENDBLK + MOV (A),D + BIC #177700,D ;GET THE HEADER LENGTH IN WORDS +FIND.9: CLR BLKNT ;NOW SKIP THE HEADER + MOV #-1,BLKINC +FIND.6: MOV (A)+,(B)+ ;WRITE ENTRY AND LOOK AT NEXT + SOB D,FIND.6 +;FALLS THROUGH + ;FALLS IN +FIND.7: CMP A,#0 +ENDBLK=.-2 + BLO FIND.1 ;CONTINUE + BR FIND.5 ;END OF DIR SO IT GOES HERE + +FIND.8: MOV 6(A),ENDBLK + ADD A,ENDBLK ;MAKE IT ABSOLUTE + MOV (A),D ;LEGNTH OF SELF ENTRY + INC D + BIC #177401,D ;SKIP SELF AND PARENT ENTRIES + MOV A,E + ADD D,E + ADD (E),D ;LEGNTH OF PARENT ENTRY + INC D + BIC #177401,D + ASR D ;WORD COUNT + BR FIND.9 ;SKIP THEM BOTH + ;SEARCHES OLD DIR TO FIND NEW AND PUTS IT IN DIRIN +;SETS UP ALL RELEVENT POINTERS + +RDDIR: JSR PC,FIND.0 ;FIND ENTRY WITH THAT NAME (DPNAM) + BEQ RDIR.2 ;NOT FOUND + JSR PC,RDDISC + BEQ RDIR.2 ;NO DISCRIPTOR +RDIR.1: MOV #DIRIN,A + MOV #DIROUT,B + MOV BLKINC,#0 ;SAVE BLK # +DIRBLK=.-2 + BR RDBLK +RDIR.2: JSR F,TYPE + .ASCIZ /DIRECTORY NOT FOUND/ + .EVEN +RDIR.3: JMP RDSETC + + + ;WRITES OUT DIR IN DIROUT + +WTDIR: CLR (B) ;LOGO WANTS ZERO AT END + MOV DIRBLK,BLKINC + MOV #DIROUT,A + SUB A,B ;FIND LEGNTH + TST NDIRSW + BNE WDIR.3 ;NEW STYLE DIRECTORIES + CMP B,#1774 + BGE WDIR.1 + NEG B + ADD #2000,B + MOV B,1776(A) ;STORE BLK LEGNTH IN LAST WORD + BR WTBLK +WDIR.1: JSR F,TYPE + .ASCIZ /DIRECTORY FULL?/ + .EVEN +WDIR.2: BR RDIR.3 +WDIR.3: CMP B,#2000 + BGE WDIR.1 + MOV B,6(A) + BR WTBLK ;WRITE OUT BIT TABLE + +WTBITS: MOV BITBLK,BLKINC + MOV #BITAB,A + BR WTBLK ;DOES RTS PC + + + +;READS BIT-TABLE INTO BITAB AND THEN READS ROOT DIR + +RDBITS: MOV #ROOTBK,BLKINC ;READ ROOT + JSR PC,RDIR.1 + MOV DIRIN,#0 +NDIRSW=.-2 + BIC #173777,NDIRSW + MOV #DPNAM,E + MOV #"BI,(E)+ + MOV #"TS,(E)+ + CLR (E) ;LOOK FOR BITS IN ROOT DIR + JSR PC,FIND.0 + BEQ RBIT.1 ;IT SHOULD BE THERE!? + JSR PC,RDDISC + BEQ RBIT.1 ;IT SHOULD HAVE A DISCRIPTOR!? + MOV #BITAB,A + MOV BLKINC,#0 ;SAVE BLK # +BITBLK=.-2 + JSR PC,RDBLK ;GO GET IT + MOV #ROOTBK,BLKINC + BR RDIR.1 +RBIT.1: JSR F,TYPE + .ASCIZ /BITS NOT FOUND?/ + .EVEN +RBIT.2: BR WDIR.2 + ;READS/WRITES THE DISK BLOCK # (BLKINC) TO/FROM BUFFER ADDRESS IN A +;CLOBBERS NO REGS + +RDBLK: MOV #5,FICS + BR WTBL.0 +WTBLK: MOV #3,FICS +WTBL.0: MOV A,FIBA + MOV A,-(SP) + MOV B,-(SP) + CLR A + MOV #0,B ;COMPUTE DISK ADDRESS +BLKINC=.-2 + CMP WCHDSK,#FXWRT ;USE DIFFERENT MAPS FROM BLK# TO DA + BEQ WTBL.2 + ASL B + DIV #14,A + ASH #4,A + ADD A,B + ADD #20000,B ;WHICH PLATTER +WCHPLT=.-2 +WTBL.1: MOV B,FIDA + JSR PC,@#MVWRT ;DO TRANSFER +WCHDSK=.-2 +FIDA: 0 +FIBA: 0 +FIWC: -1000 +FICS: 0 + MOV (SP)+,B + MOV (SP)+,A + RTS PC + +WTBL.2: ASHC #11,A ;2**10. BYTES PER BLOCK + MOV A,FIDE + BR WTBL.1 +FIDE: 0 ;FIXED DAE + + + ;DISK READ/WRITE ROUTINE SELECTS DISK AND LOADS REGS + + +FXWRT: MOV #400,DCS ;POWER CLEAR (IN CASE THIS IS A RETRY) + MOV #"FD,MVDS.2 ;R/W ON FIXED DISK + MOV #DAE,A + MOV FIDE,(A) + BR MVDS.0 +MVWRT: MOV #1,RKCS ;CONTROL RESET IN CASE THIS IS A RETRY + MOV #RKDA+2,A ;R/W ON MOVING DISK + MOV #"MD,MVDS.2 +MVDS.0: MOV (SP),B ;ADDRESS OF ARGUMENTS + MOV (B)+,-(A) ;DAR + MOV (B)+,-(A) ;CMA + MOV (B)+,-(A) ;WC + MOV (B)+,-(A) ;DCS +MVDS.1: TSTB (A) + BPL MVDS.1 + TST (A) + BPL MVDS.3 + JSR F,TYPE +MVDS.2: .ASCIZ /FD ERR? / + .EVEN + JMP @WCHDSK +MVDS.3: TST (SP)+ ;POP ARGUMENTS ADDRESS + JMP (B) + ;THIS ROUTINE R/W ON THE SYSTEM DEVICE +;CALLED BY USE OF F AND CLOBBERS E + + +SYSDSK: MOV D,-(SP) +SYSD.3: +.IFNZ F.HD + MOV #DAE,D + MOV (F)+,(D) ;DAE +.IFF + MOV #RKDA+2,D +.ENDC + MOV (F)+,-(D) ;DAR + MOV (F)+,-(D) ;CMA + MOV (F)+,-(D) ;WC + MOV (F)+,-(D) ;DCS +SYSD.1: TSTB (D) + BPL SYSD.1 + TST (D) + BMI SYSD.2 + MOV (SP)+,D + RTS F +SYSD.2: +.IIF NZ F.HD, SUB #12,F +.IIF Z F.HD, SUB #10,F + MOV A,-(SP) + JSR F,TYPE + .ASCIZ /SD ERR? / + .EVEN + MOV (SP)+,A +.IIF NZ F.HD, MOV #400,DCS ;POWER CLEAR +.IIF Z F.HD, MOV #1,RKCS ;CONTROL RESET + BR SYSD.3 + ;LOADS A FILE AND SYMBOL TABLE IN ABSOLUTE LOADER FORMAT +;FROM DISK TO RUG SWAP AREA (RUG'S $L COMMAND) + + +LOADF: JSR PC,FNDF.2 ;$L COMMAND ENDS UP HERE + JSR PC,LODFIL + BR LODF.0 + +LODFIL: BNE LODF.1 ;ALSO CALLED BY LOGO BOOT +LODFER: JSR F,TYPE + .ASCIZ /FILE NOT FOUND?/ + .EVEN +LODF.0: JMP DUMP.4 +LODF.1: CLR 0 ;ZERO SWAP AREA ON DISK + MOV C,LODR2 ;SAVE FOR LODBLK AND RDDISC + MOV D,LODR3 + JSR F,SYSDSK +.IIF NZ F.HD, 400 ;DISABLE AUTOINCREMENT + SPRG + 0 + -SPRGL +.IFNZ F.HD + 3 +.IFF + 4003 +.ENDC + MOV #RUGFNT,O.SYME + JSR F,SYSDSK ;ZERO SYMBOL TABLE +.IIF NZ F.HD, 400 + SSTBL + 0 + -> +.IFNZ F.HD + 3 +.IFF + 4003 +.ENDC +.IFNZ MVFO2 + JSR F,SYSDSK +.IIF NZ F.HD, 0 + SSTBLB + DIROUT + -DSKBSZ + 5 + MOV #MVFO2,A ;ZERO THIS MANY WORDS + MOV #DIROUT,C +LODF.3: CLR (C)+ + SOB A,LODF.3 + JSR F,SYSDSK +.IIF NZ F.HD, 0 + SSTBLB + DIROUT + -DSKBSZ + 3 +.ENDC + + MOV #BITAB+2000,A ;SO LODBYT WILL GET A BLOCK + MOV #SPRG,SWAPST + JSR PC,ABSLOD ;LOAD THE PROGRMA + MOV E,ADRES +.IFNZ F.HD + MOV #SSTBL-,SWAPST +.IFF +MVAD ,MVFOO +MVFO1==SSTBL-MVFOO +.IFL - +MVFO1=MVFO1-4 +.ENDC + + MOV #MVFO1,SWAPST ;ABSLOD WILL ADD CSTBL TO THIS TO GET THE DISK ADDRESS +.ENDC + + JSR PC,ABSLOD ;GET THE SYMBOL TABLE + MOV E,O.SYME + RTS PC + ;LOADS FRAMES INTO CORE +;A IS POINTER IN DISK BLOCK (0 - 2000) +;B IS POINTER IN CORE (ABSBUF - AS FAR AS NECESSARY) +;C IS SCRATCH +;D IS WHERE LODBYT AND LODWRD RETURN VALUES +;E IS BYTE COUNT +;F IS CHECKSUM + + +ABSLOD: JSR PC,LODBYT ;READ FRAMES UNTIL END FRAME IS FOUND + CMPB #1,D + BNE ABSLOD ;LOOK FOR BYTE = OO1 + MOV D,F ;CHECKSUM + JSR PC,LODBYT ;SKIP BYTE OF ZERO + JSR PC,LODWRD ;GET BYTE COUNT + MOV D,E + JSR PC,LODWRD ;GET ADDRESS + SUB #6,E ;ALREADY HAVE 6 BYTES + BNE LOD.3 + MOV D,E + JSR PC,LODBYT + TSTB F + BNE LODERR ;CHECKSUM ON LAST FRAME TOO BAD + RTS PC ;LAST FRAME HAS LENGTH 6 +LOD.3: MOV #ABSBUF,B + MOV D,-(SP) ;SAVE START ADDRESS OF FRAME + CLC + ROR (SP) ;MAKE IT A WORD ADDRESS + + +.IFNZ F.HD ;COMPUTE DAR + CLR LOD.9-2 ;EXTENSION ADDRESS + ADD #SPRG,(SP) +SWAPST=.-2 + ADC LOD.9-2 + +.IFF + BIC #377,(SP) + MOV (SP),MDSAV + JSR PC,MDCNVT + MOV #SPRG,MDSAV+2 +SWAPST=.-4 + JSR PC,MDADD + MOV MDSAV,(SP) +.ENDC + BIC #-,D +.IFNZ F.HD + BIC #DSKBSZ-1,(SP) ;MAKE IT BLOCK ADDRESS + MOV LOD.9-2,LOD3A-2 ;EXTENSION ADDRESS +.ENDC + ADD D,B ;WHERE TO START PUTTING BYTES + MOV (SP),LOD3A ;DAR + JSR F,SYSDSK ;READ A BLOCK +.IIF NZ F.HD, 0 +LOD3A: 0 + ABSBUF + -DSKBSZ + 5 +LOD.4: JSR PC,LODBYT + MOVB D,(B)+ ;PUT BYTE IN BUFFER + SOB E,LOD.4 + JSR PC,LODBYT ;GET THE CHECKSUM + TSTB F + BEQ LOD.5 ;IT CHECKS +LODERR: JSR F,TYPE + .ASCIZ /CHECKSUM ERROR?/ + .EVEN +LOD.ER: JMP LODF.0 ;ABORT + LOD.5: MOV #-DSKBSZ,LOD10 +.IIF NZ F.HD, MOV LOD3A-2,LOD.9-2 + CMP #ABSBUF+,B ;IS IT MORE THAN ONE BLOCK ORTH? + BHIS LOD.8 ;NO + MOV B,C ;THE FIRST BYTE NOT WRITTEN + SUB #ABSBUF,C ;CHANGE TO POSITIVE BYTE COUNT + CLC + ROR C ;NOW, POSITIVE WORD COUNT + BIC #DSKBSZ-1,C ;ROUNDED DOWN, GIVES OFFSET TO START OF LAST BLOCK + MOV C,D ;COPY TO FART AROUND WITH + ADD #DSKBSZ,D ;COUNT OF THE WHOLE ABSBUF, ROUNDED + MOV D,LOD10 ;TO RITE OUT ABSBUF + NEG LOD10 + ASL D ;BYTE COUNT OF WHOLE BUFFER + ADD #ABSBUF,D ;POINTS PAST LAST REAL BYTE IN BUFFER + ;NOTE THAT SOME OF THE BUFFER GETS FILLED IN BELOW + ;SO FAR WE JUST HAVE FROM ABSBUF TO (B)-1 REAL BYTES + +.IFNZ F.HD + MOV LOD.9-2,LOD.6-2 + MOV (SP),F + ADD C,F ;READ BLOCK AT END FROM DISK + ADC LOD.6-2 +.IFF + MOV C,MDSAV ;CONVERT WC TO DISC ADDRESS + JSR PC,MDCNVT + MOV (SP),MDSAV+2 + JSR PC,MDADD + MOV MDSAV,F +.ENDC + MOV F,LOD.6 + JSR F,SYSDSK ;GET END BLOCK +.IIF NZ F.HD, 0 +LOD.6: 0 + DIROUT + -DSKBSZ + 5 + MOV #DIROUT+,C +LOD.7: MOVB -(C),-(D) ;FILL REST OF BLOCK + CMP B,D + BNE LOD.7 +LOD.8: MOV (SP)+,LOD.9 ;DAR'S + JSR F,SYSDSK ;WRITE FRAME ON DISK +.IIF NZ F.HD, 0 +LOD.9: 0 + ABSBUF +LOD10: 0 + 3 + JMP ABSLOD ;GET ANOTHER FRAME + ;GETS BYTE INTO D FROM BLOCK POINTED AT BY A +;IF IT REACHES THE END OF THE BLOCK IT GETS ANOTHER +;IF NO MORE ARE AVAILABLE IT BARFS + + +LODBYT: CMP A,#BITAB+2000 ;END OF BLOCK? + BLO LDBY.1 ;NO WE DONT NEED ANY THANK YOU + MOV C,-(SP) + MOV D,-(SP) + MOV E,-(SP) + MOV LODR3,D + MOV LODR2,C ;POINTERS FOR RDDISC + MOV #BITAB,A + JSR PC,RDDISC + BNE LDBY.0 + JSR F,TYPE + .ASCIZ /BAD FILE/ + .EVEN + BR LOD.ER +LDBY.0: JSR PC,RDBLK + MOV C,#0 +LODR2=.-2 + MOV D,#0 +LODR3=.-2 + MOV (SP)+,E + MOV (SP)+,D + MOV (SP)+,C +LDBY.1: MOVB (A)+,D + ADD D,F ;CHECKSUM + RTS PC + ;RETURNS WORD IN D ASSUMES THAT THERE ARE 2 BYTES LEFT IN FRAME + +LODWRD: JSR PC,LODBYT + MOVB D,C + JSR PC,LODBYT + SWAB D + CLRB D + BISB C,D + RTS PC + +.ENDC + ;DISC ROUTINES +;4000-20000 ON DISC RESERVED FOR AN INVIOLATE COPY OF RUG +;RUG AUTOMATICALLY WRITES THERE WHEN LOADED +;$^U WILL READ IT BACK + +;FOLLOWING ARE WORD ADDRESSES +;20000-110000 ARE RESERVED FOR SWAPPING PROGRAM +;110000-143400 ARE RESERVED FOR SWAPPING SYMBOL TABLE +;143400-157400 ARE FOR SWAPPING RUG + + +;ON MOVING HEAD DISK, BOTTOM 100 SECTORS FOR RON +;DUMP TRACKS 1-9, EACH 300 SECTORS LONG + +;THIS CALCULATES TRACK ADDRESS START, LEAVING +;THAT IN A AND 3 IN D +;IF MOVING HEAD TRACK B=-1 AT END +;D AND E BOTH INITIALLY CONTAIN 3 FOR WRITE OR 5 FOR READ + + + +.IFZ FMH + +.IFNZ F.HD +DISC: MOV #TRKS-TRKL,A +.IFNZ M1145 + MOV #THTRKS,B +.ENDC +.IFZ M1145 + CLR B +.ENDC + CMP E,#11 + BHI DSCER +.IFNZ M.HD + CMP E,#1 + BGE DSCM +.ENDC +DSC1: ADD #TRKL,A + ADC B + DEC E + BGE DSC1 +MHD: MOV #SPRG,C + MOV #3,D + MOV D,E + RTS PC +DSCER: TST (SP)+ ;FROM SBRTNE, SO POP STACK +DSCERR: JMP O.ERR +.ENDC + +.IFZ F.HD +DISC: MOV #TRKS-MTL,A + CMP E,#5 + BHI DSCER +DSC1: ADD #MTL,A + DEC E + BGE DSC1 + MOV #SPRG,C + MOV #3,D + MOV D,E + BIS PMKDA,A + RTS PC +DSCER: TST (SP)+ +DSCERR: JMP O.ERR +.ENDC + +.IFNZ F.HD + +.IFNZ M.HD +DSCM: DEC B + MOV #LOWAD-MTL,A + DEC E +MD1: ADD #MTL,A + DEC E + BGE MD1 + BIS PMKDA,A + BR MHD +.ENDC +.ENDC + +DUMP: ;N^D +.IFNZ M.HD + CLR PMKDA +.ENDC +DUMP1: JSR PC,DSTBL ;DO SYMBOL TABLE TRANSFER + JSR PC,DISC ;CONVERTS TO DISC ADDRESS, IN A (OVERFLOW IN B) + CMPB (E)+,(E)+ ;NOW E HAS 5 IN IT + MOV #DMP,FIRSTR + MOV #DMPT,SCNDR + JSR PC,DMPSUB + BR UNSV + +UNSAVE: ;N^U +.IFNZ M.HD + CLR PMKDA +.ENDC +UNSV1: JSR PC,USAVE +UNSV: JMP O.DCD + + + +USAVE: JSR PC,DISC ;READS FIRST 10000 TRACK 0 LOCS + CMPB (D)+,(D)+ ;NOW D HAS 5 IN IT + MOV #DMPT,FIRSTR + MOV #DMP,SCNDR + JSR PC,DMPSUB + JMP REINIT + + + FIRSTR: 0 +SCNDR: 0 ;RTNES TO BE CALLED IN DUMPING + +DMPSUB: +.IFNZ F.HD + TST B + BGE DMS1 + MOV D,B ;SO RTNES KNOW WHICH DISK +.ENDC +DMS1: MOV #-<&77777>>/2>,F ;SHOULD BE 22000 FOR HCOR=160000 + + JSR PC,CALLRS + JSR PC,CALLRS + MOV #-<</2>&77777>,F +;FALL INTO CALLRS + +CALLRS: JSR PC,@FIRSTR + JMP @SCNDR +DMP: ;FOR GETTING OR STORING INTO SWAP AREA +.IFNZ F.HD + MOV C,DMPDAR + CLR DMPDAE + MOV E,DMPDCS + SUB F,C +DMPP: MOV F,DMPWC + JSR 5,FDISK +DMPDAE: 0 +DMPDAR: 0 + 0 +DMPWC: 0 +DMPDCS: 0 + RTS PC +.ENDC + +.IFZ F.HD +.IFNZ M.HD +MDMP: MOV C,SPMKDA + MOV E,SPMKCS + MOV F,SPMKWC + MOV F,MDSAV + NEG MDSAV + JSR PC,MDCNVT + JSR 5,MDISK +SPMKDA: 0 + 0 ;MEMORY ADDRESS +SPMKWC: 0 +SPMKCS: 0 + MOV C,MDSAV+2 + JSR PC,MDADD + MOV MDSAV,C + RTS PC +.ENDC +.ENDC + +DMPT: ;FOR GETTING OR WRITING INTO TRACK +.IFNZ F.HD +.IFNZ M.HD + CMP B,D + BEQ MDMPT +.ENDC + MOV A,DMPDAR + MOV B,DMPDAE + MOV D,DMPDCS + SUB F,A + SBC B + INC B ;CARRY IS OPPOSITE OF WHAT IT SHOULD BE + BR DMPP +.ENDC + + .IFNZ M.HD +MDMPT: MOV A,PMKDA + MOV D,PMKCS + JSR PC,PMDSK + MOV A,MDSAV+2 + JSR PC,MDADD + MOV MDSAV,A + RTS PC + +PMDSK: MOV F,PMKWC + MOV F,MDSAV + NEG MDSAV + JSR PC,MDCNVT +PM1: JSR 5,MDISK +PMKDA: 0 + 0 ;RKBA +PMKWC: 0 +PMKCS: 0 + RTS PC +.ENDC + .ENDC + +FDISK: +.IFNZ F.HD + MOV #10,-(SP) ;RETRY COUNT +.ENDC +FDISK1: +.IFNZ F.HD + MOV (F)+,DAE + MOV (F)+,DAR + MOV (F)+,CMA + MOV (F)+,WC + MOV (F)+,DCS + MOV #"FD,DERRTP +;FALL INTO SOOTH +SOOTH: TSTB DCS + BPL SOOTH + TST DCS ;WRITE ERROR? + BPL SOTH +DSER: INCB DCS+1 ;POWER CLEAR +.ENDC +DSERR: MOV A,-(SP) + JSR 5,TYPE +DERRTP==. + .ASCIZ /MDE? / + .EVEN + CLR A ;NOW WAIT FOR THE DISK TO SETTLE +1$: DEC A + BNE 1$ + MOV (SP)+,A + DEC (SP) ;DECREMENT ERROR COUNT + BNE DSRTRY ;TRY AGAIN + HALT ;IT IS PROBABLY WRITE PROTECTED + MOV #10,(SP) +DSRTRY: SUB #10,F + CMP #"MD,DERRTP + BEQ MDISK1 + TST -(F) ;FIXED DISK HAS AN EXTRA REGISTER + BR FDISK1ī +SOTH: TST (SP)+ ;POP ERROR COUNT + RTS F + +MDISK: +.IFNZ M.HD + MOV #10,-(SP) ;RETRY COUNT +.ENDC +MDISK1: +.IFNZ M.HD + MOV (F)+,RKDA + MOV (F)+,RKBA + MOV (F)+,RKWC + MOV (F)+,RKCS + MOV #"MD,DERRTP +;FALL INTO MOOTH +MOOTH: TSTB RKCS + BPL MOOTH + TST RKCS + BPL SOTH +MSER: MOV #1,RKCS + BR DSERR +.ENDC + ;PROCESS $^U +BOOT: +.IFNZ F.HD + JSR 5,FDISK + 0 + INVRG ;DAR +.ENDC +.IFZ F.HD + JSR 5,MDISK + LOWAD +.ENDC + RUGFNT ;CMA + -INVRGL ;WC + 5 ;DCS +BOOT.1: JMP O.ODT + + +;PROCESS FOO^A, WHICH MAKES $G START AT FOO +GOADR: TST C + BEQ PGOADR + MOV E,ADRES +GOAD1: JMP O.DCD +PGOADR: JSR 5,TYPE + .BYTE 40 + .BYTE 0 + MOV ADRES,A + CLRB REGINF + JSR 5,SYMBOL + BR GOAD1 + +REINIT: MOVB #-1,O.P + CLR O.CSR1 + CLR O.UST + MOV #USP,B +.IFNZ M1145 + MOV #O.UST+2,SAVKR6 + CMP R6AD,#SAVKR6 + BNE NOTDUN +.ENDC + MOV #O.UST+2,(B) +NOTDUN: CLR -(B) + CMP B,#O.UR0 + BNE NOTDUN + MOV #SAVDCS,B +NOTDN1: CLR (B)+ +.IIF Z F.HD, CMP #SAVDAR+2,B +.IIF NZ F.HD, CMP #SAVDAE+2,B + BNE NOTDN1 +.IFNZ M1145 + CLR SAVSLR + CLR SVSSR3 + CLR SVSSR0 +.ENDC + CLR B +1$: DEC B + BNE 1$ ;WAIT ABOUT 1/3 SEC FOR I/O TO FINISH, ESP 11-TO-10 + RESET + JMP DELT ;WILL RTS PC FOR US + + +DSTBL: +.IFNZ F.HD + JSR 5,FDISK + 0 +.ENDC +.IFZ F.HD + JSR 5,MDISK +.ENDC + SSTBL + CSTBL + -SSTBLL + 3 + RTS PC + +.IFNZ M.HD +MDSAV: 0 ;ARG AND RESULT OF MDCNVT + 0 ;OPTIONAL OFFSET ARGUMENT TO MDSAV + +MDCNVT: MOV E,-(SP) ;LOOKS LIKE SAVING & RESTORING E IS UNNECESSARY, BUT UNCERTAIN *** + CLRB MDSAV + SWAB MDSAV + DIVIDE MDSAV,#14,SCRTCH,MDSAV + MLTPLY SCRTCH,#20,SCRTCH + ADD SCRTCH,MDSAV + MOV (SP)+,E + RTS PC +MDADD: MOV E,-(SP) + MOV MDSAV,E + BIC #177760,E + ADD MDSAV+2,MDSAV + BIC #177760,MDSAV+2 + ADD MDSAV+2,E + CMP #14,E + BGT MDAD1 + ADD #4,MDSAV +MDAD1: MOV (SP)+,E + RTS PC + +.ENDC +.IFZ FMH + +STLOGO: MOV #O.UR0,SP ;START TRACK 0 (LOGO) + CLR E + JSR PC,USAVE + JMP GO22 + +.IFNZ M.HD + + +BKUP: MOV #1,B + JSR PC,VERIF + MOV #5,E + MOV #3,F +BKUP1: MOV #20000,C ;COPY FROM DRIVE 1 TO 0 + CLR D +BK: MOV #313*2,A + CLR B +BKLOOP: BIC D,B + BIS C,B + MOV E,BKCS + JSR PC,MBKE + BIC C,B + BIS D,B + MOV F,BKCS + JSR PC,MBKE + ADD #20,B + DEC A + BNE BKLOOP + JMP O.DCD + +GBK: CLR B + JSR PC,VERIF + MOV #5,E + MOV #3,F + MOV #20000,D + CLR C + BR BK + MBKE: MOV B,BKDA + JSR 5,MDISK +BKDA: 0 ;RKDA + 0 ;RKBA + -3072. ;RKWC +BKCS: 0 ;RKCS +VRFOK: RTS PC + +WCHECK: MOV #5,E + MOV #7,F + BR BKUP1 + +VERIF: +.IFZ COMPUTER-1 +;CHECK SWITCH ON LOGO MOVING HEAD DISK WHICH INVERTS LOW DRIVE SELECT BIT +;CALLED IN $$^U (COPY DRIVE 0 TO 1) AND $$^D (COPY DRIVE 1 TO 0) + CLR RKDA ;SELECT DRIVE 0 + MOV #1,RKCS ;GATE DRIVE INTO RKDS + BIT #20000,RKCS ;IS IT REALLY DRIVE 0? + BEQ INVROK ;YES, NOT INVERTED + JSR 5,TYPE + .ASCIZ \WARNING, DISK INVERTED. OK?\ + .EVEN + JSR PC,GET1UC + CMPB A,#'Y + BNE VRFERR + JSR PC,CRLF +INVROK: +.ENDC + ADD #60,B + MOVB B,DRVFRM + INC B ;CHEAP XOR #1,B + BIC #2,B + MOVB B,DRVTO + JSR 5,TYPE + .ASCII \COPY DRV \ +DRVFRM=. ;DRIVE NUMBER OF "FROM" DRIVE + .ASCII \0 TO DRV \ +DRVTO=. ;"TO" DRIVE + .BYTE '0,'?,0 + .EVEN + JSR PC,GET1UC + CMPB A,#'Y + BEQ VRFOK +VRFERR: MOV #O.UR0,SP + JMP O.ERR + + +.ENDC + +.IFF +STLOGO: + +.IFNZ F.HD + MOV #FXWRT,WCHDSK +.IFF + MOV #MVWRT,WCHDSK + CLR WCHPLT +.ENDC + MOV #ROOTBK,BLKINC + JSR PC,RDIR.1 + MOV #'.,DPNAM + JSR PC,RDDIR + MOV #"SI,DPNAM + MOV #"TS,DPNAM+2 + CLR DPNAM+4 + JSR PC,FIND.0 + BNE 1$ + JMP O.ODT +1$: JSR PC,LODFIL + JSR PC,SYMINT + JSR PC,REINIT + JMP GO22 +.ENDC + + ;ABS LOADER +.IFNZ FPTR +DEVICE=177550 +.ENDC + +.IFZ FPTR +DEVICE=O.RCSR +.ENDC +L.LD2: MOV #L.READ,F + CLR A + JSR PC,@F + CMP D,#EOT + BNE L.LD2B + HALT +L.LD2B: DECB D + BNE L.LD2 + JSR PC,@F + + JSR PC,L.GWRD + MOV E,C + SUB #4,C + CMP #2,C + BEQ L.JMP + JSR PC,L.GWRD + MOV E,B + ADD RELOC,B + +L.LD3: JSR PC,@F + BGE L.LD4 + TSTB A + BEQ L.LD2 +L.BAD: HALT + BR L.LD2 +L.LD4: MOVB D,(B)+ + BR L.LD3 + +L.READ: MOV #DEVICE,D + INCB @D +L.R1: TSTB @D + BPL L.R1 + MOVB 2(D),D + ADD D,A + BIC #177400,D + DEC C + RTS PC + +L.GWRD: MOV (SP)+,L.TMP + JSR PC,@F + MOV D,E + JSR PC,@F + SWAB D + BIS D,E + MOV L.TMP,PC + +L.JMP: JSR PC,L.GWRD + JSR PC,@F + TSTB A + BNE L.BAD + ASR E + BCC L.JMP1 + HALT +L.JMP1: RTS PC + +L.TMP: .WORD 0 +RELOC: 0 + ;CONSOLE PROGRAM FOR THE PDP11 + +WORD=. +XWORD: 0 + +CNSL.1: CLR TPS ;NO INTRPTS ON TTO + CLR TKS ;NO INTRPTS IN TTI +XHERE3: MOV #XBUFF,F + CLR (F) + MOV F,E + +XHERE: TSTB RCSR + BMI XTENI ;CHAR ARRIVED FROM 10 +XTHERE: TSTB TPS ;TTO READY? + BMI XTTOUT +XTHR: TSTB TKS + BPL XHERE ;NONE FROM TTY + +XITTI: MOVB TKB,B +XITTI1: MOV C,-(P) + MOV B,C + JSR PC,SENDTC + MOV (P)+,C + BIC #177600,B + CMP B,#19. ;^S + BEQ XHERE3 + BR XHERE + +XTENI: MOVB RBUF,B ;GET CHAR + BIC #177600,B ;MASK JUNK + CMP B,#1 ;START OF BLOCK? + BEQ XRETN + BLT XOK ;BAD TO STRE ZERO IN BUFFER + TST A + BNE XOK2 + CMP B,#2 ;LODER SENDS THAT AT IRST. THEN ECHO (IN RUG) + BNE XOK + INC A +XOK2: MOVB B,(F)+ + CMP F,#XBUFF+200 + BLE XOK + MOV #XBUFF,F +XOK: CLRB (F) + BR XTHERE + +XTTOUT: TSTB (E) + BEQ XTHR + MOVB (E)+,TPB + CMP E,#XBUFF+200 + BLE XTHR + MOV #XBUFF,E + BR XTHR + +;LOAD A SYMBOL TABLE IN SPECIAL 11LOGO;LODER FORMAT + +XSTBLK: JSR PC,XREAD ;LOADS SYMBOL TABLE FOR $LT ALSO + DECB D ;CHECK FOR +1 (START OF BLOCK) + BNE XSTBLK + JSR PC,XREAD ;READ ANOTHER CHAR (0 THIS TIME) + MOV #5,C ;WON'T SKIP IN XGWORD WHEN DEC & WILL =3 AFTER + CLR A + JSR PC,XGWORD ;GET TOTAL BYTE COUNT + SUB C,XWORD ;C=3 + CMP C,XWORD ;DOES IT = 3? + BEQ XJMPBLK + MOV XWORD,C + JSR PC,XGWORD ;GET LOAD ADDRESS + MOV XWORD,B ;PUT ADDRESS IN PROPER PLACE + ADD RELOC,B + MOV B,O.SYME ;NEW BOTTOM OF SYMBOL TABLE + + ;READ IN REMAINDER OF DATA +XLDATA: JSR PC,XGWORD + TST C ;STILL DATA LEFT? + BGT XLDLP + BLT XCHECKS ;JUST CHECKSUM + MOVB XWORD,(B)+ ;ONE DATA, ONE CHECKSUM +XCHECKS: INCB A + BNE XBAD + JSR F,ACN + 4 + BR XSTBLK +XLDLP: MOVB XWORD,(B)+ + MOVB XWORD+1,(B)+ + BR XLDATA + TENPNT: 0 +XREAD: .IFNZ TEN11 + TST TEN11S + BEQ XREADL +1$: TST TENCNT + BEQ 1$ + MOVB @TENPNT,D + DEC TENCNT + BNE 2$ + MOV #TENBUF-1,TENPNT +2$: INC TENPNT + BR XREAD1 +.ENDC +XREADL: TSTB RCSR ;CHAR SENT YET? + BPL XREAD ;NO + MOVB RBUF,D +XREAD1: BIC #177600,D ;MASK OFF PARITY ETC + SUB #40,D ;+40 AVOIDS CONTROL CHARATERS +XRETN: RTS PC + +;INSTEAD OF 8 BIT FRAMES 6 BITS, THEN 4 THEN 6 WILL BE +;SENT THIS TOTALS 16 BITS +XGWORD: JSR PC,XREAD + MOV D,XWORD ;WANT TO ZERO TOP BYTE + JSR PC,XREAD + SWAB D + ASR D + ASR D + ADD D,XWORD + ADD XWORD,A + DEC C + BEQ XDONE + JSR PC,XREAD + SWAB D + ASL D + ASL D + ADD D,XWORD + MOVB XWORD+1,D + ADD D,A +XDONE: DEC C + RTS PC + + XJMPBLK: JSR PC,XGWORD + MOV XWORD,B + JSR PC,XGWORD + INCB A + BNE XBAD + JSR F,ACN + 4 + RTS PC + +XENDCNS: ASR B + BCC XJUMP + HALT +XBAD: JSR F,ACN + 6 + BR XSTBLK + +XJUMP: JSR F,ACN + 47 ;DON'T SEND SYMBOLS + ASL B + JMP (B) + +ACN: .IFNZ TEN11 + TST TEN11S + BEQ ACNL +1$: TST TENCHR + BNE 1$ + MOV (F)+,TENCHR + RTS F +.ENDC +ACNL: MOV C,-(P) + MOV (F)+,C + JSR PC,ACK + MOV (P)+,C + RTS F + +XBUFF: 0 +.=.+200 +RUGEND==. + ;COMMUNICATION ROTUINES +;SEND C TO THE TEN, EITHER BY THE LINE OR BY THE TEN/11 INTERFACE +SENDC: +ACK: .IFNZ TEN11 + TST TEN11S + BEQ SENDTC +ACKT: TST TENCHR + BNE ACKT + MOV C,TENCHR + RTS PC +.ENDC + +;SEND C TO THE TEN, ALWAYS OVER THE LINE +SENDTC: TSTB TSCR + BPL SENDTC + MOV C,TBUF + RTS PC + +;INITIALIZE THE LINE TO THE TEN +LINEIN: MOV #DCSPD,RCSR + MOV #DCSPD,TSCR ;INITIALIZE THE LINES + RTS PC + +WAIT10: TSTB RCSR ;TIMING THING + BPL WAIT10 + MOVB RBUF,B + RTS PC + + + + + + + + + + + + + .IFZ M1145 +.=HCOR-700 +.ENDC +.IFNZ M1145 +.=HCOR-1000 +.ENDC +RUGST: BR RUGS1 ;ENTRY TO START RUG=1 + INCB RESTFL ;ENTRY TO START LOGO=2 +RUGS1: INCB #0 +RESTFL=.-2 + TSTB #0 +INPFL=.-2 + BNE O.BRKS + JMP RESART + +O.BRK: MOV (SP)+,O.UPC + MOV (SP)+,O.UST +O.BRKS: MOV SP,O.USP +.IFNZ M1145 + MOV SSR0,SVSSR0 ;SAVE SEGMENTATION REGS + BIC #1,SSR0 ;DISABLE SEGMENTATION + MOV SSR3,SVSSR3 + MOV STACKR,SAVSLR ;STACK LIMIT REGISTER + CLR STACKR + MOV #7,SSR3 ;ENABLE D SPACE + BIC #4000,PSW +.ENDC + MOV A,(PC)+ +SAVR0: 0 + MOV B,(PC)+ +SAVR1: 0 +.IFNZ DM11 + MOV #DMCSR+2,B +DMWAIT: TST (B) + BNE DMWAIT ;USED TO BE BNE O.BRKS *** + MOV -(B),(PC)+ +SAVDM: 0 + CLR (B) +.ENDC + MOV #SAVDCS,A +.IFNZ F.HD + MOV #DCS,B +.ENDC +.IFZ F.HD + MOV #RKCS,B +.ENDC +GLOP1: TSTB (B) + BPL GLOP1 + MOV (B)+,(A)+ ;SAVDCS + MOV (B)+,(A)+ ;SAVWC + MOV (B)+,(A)+ ;SAVCMA + MOV (B)+,(A)+ ;SAVDAR +.IFNZ F.HD + MOV (B),(A)+ ;SAVDAE +.ENDC +;FALLS THROUGH + ;FALLS IN +LOZT: MOV #10,A ;COUNT +LOST: +.IFNZ F.HD + MOV #DAE,B ;IN CASE LOOP BACK HERE + CLR (B) +.ENDC +.IFZ F.HD + MOV #RKDA+2,B +.ENDC + MOV #SPRG,-(B) + CLR -(B) ;CMA + MOV #-SPRGL,-(B) ;WC + MOV #3,-(B) +GLOP2: TSTB (B) + BPL GLOP2 + TST (B) + BPL GLOK +.IFNZ M1145+M1140 + SOB A,LOST +.IFF + DEC A + BGT LOST +.ENDC + HALT ;IT'S HOPELESS + BR LOZT ;MAYBE IT NEEDS TIME +SHLOCK: MOVB #10,A +GLOK: +.IFNZ F.HD + MOV #DAE,B + CLR (B) +.ENDC +.IFZ F.HD + MOV #RKDA+2,B +.ENDC + MOV #SSTBL,-(B) + MOV #CSTBL,-(B) + MOV #-SSTBLL,-(B) + MOV #5,-(B) +GLOP3: TSTB (B) + BPL GLOP3 + TST (B) + BPL GLOK3 +.IFNZ M1145+M1140 + SOB A,GLOK +.IFF + DEC A + BGT GLOK +.ENDC + HALT + BR SHLOCK ;YOU CERTAINLY ARE +GNOOK: HALT +GLOK3: CLRB INPFL ;NON ZERO WHEN SWAPED PROG IS IN CORE + JMP BREAK ;RESTORE A AND B THERE + + ;B CONTAINS #DCS +;A CONTAINS #SAVDCS +GOGO: INCB (B) ;READ IN USER +GOGO2: TSTB (B) + BPL GOGO2 + TST (B) + BMI GNOOK + INCB INPFL + MOV (A)+,(B)+ + MOV (A)+,(B)+ ;WC + MOV (A)+,(B)+ ;CMA + MOV (A)+,(B)+ ;DAR +.IFNZ F.HD + MOV (A)+,(B)+ ;DAE +.ENDC +.IFNZ DM11 + MOV SAVDM,DMCSR +.ENDC +;ALREADY RESTORED OTHER THINGS + MOV SAVR0,A + MOV SAVR1,B +.IFZ M1145+M1140 + RTI +.IFF +.IFNZ M1145 + MOV #0,STACKR ;RESTORE STACK LIMIT REG +SAVSLR=.-4 + MOV #0,SSR3 ;RESTORE SEGMENTATION STATUS REGS +SVSSR3=.-4 + MOV #0,SSR0 +SVSSR0=.-4 +.ENDC + RTT +.ENDC + + +;LOCATIONS FOR RESIDENT PORTION TO RESTORE BEFORE STARTING UP USER + 0 + 0 + 0 ;PIDDLE INITIALIZED TO HERE + 0 + 0 + 0 +O.UPC: 0 ;USER'S PC +O.UST: 0 ;USER'S STATUS +O.USP: 0 ;USER'S STACK POINTER (P) +SAVDCS: 0 ;SAVED DISK REGISTERS +SAVWC: 0 +SAVCMA: 0 +SAVDAR: 0 +.IFNZ F.HD +SAVDAE: 0 +.ENDC + + +.IIF P2, PFLAG RUGEND,\RUGEND +.END BEGRUG + \ No newline at end of file