diff --git a/build/misc.tcl b/build/misc.tcl index 504f4649..d84eb334 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -1642,6 +1642,10 @@ expect ":KILL" respond "*" ":palx sysspr\r" expect ":KILL" +# DDT for SITS. +respond "*" ":palx ddt\r" +expect ":KILL" + # TORTIS respond "*" ":midas;324 radia;_tortis\r" expect ":KILL" diff --git a/build/timestamps.txt b/build/timestamps.txt index 0914c386..7fe7773f 100644 --- a/build/timestamps.txt +++ b/build/timestamps.txt @@ -1905,6 +1905,7 @@ shrdlu/demo.flick 197110311951.55 shrdlu/ts.twdemo 197110311544.38 sits/-read-.-this- 197503032229.00 sits/conven.3 197503051957.44 +sits/ddt.73 197706301928.57 sits/docum.66 197607010317.17 sits/salv.175 197711241704.25 sits/sitmac.6 197609212250.40 diff --git a/src/sits/ddt.73 b/src/sits/ddt.73 new file mode 100755 index 00000000..941d7cdb --- /dev/null +++ b/src/sits/ddt.73 @@ -0,0 +1,7147 @@ + +.TITLE DDT FOR THE PDP-11 + +VERNUM==%FNAM2 +.ABS +%COMPAT==0 + +LSI==1 + +;AC AND OTHER DEFINITIONS + +A=%0 +B=%1 +C=%2 +D=%3 +E=%4 +F=%5 +P=%6 +PC=%7 + +.XCREF A,B,C,D,E,F,P,PC + +AC0==%0 +AC1==%1 +AC2==%2 +AC3==%3 +AC4==%4 +AC5==%5 + +.XCREF AC0,AC1,AC2,AC3,AC4,AC5 +BLKL==1024. +MAXDSK==3 ;THE HIGHEST LEGAL DISK NUMBER +TBIT==20 ;BIT LOCATION OF T BIT IN PS +BPTFLT==14 ;STOP WORD FOR BPT AND T-BIT FAULTS +BPTOP==3 ;OP CODE FOR BPT +NBPTS==7 ;7 BREAKPOINTS ARE IMPLEMENTED +LPDL==100 ;LENGTH OF DDT'S STACK +RUGNUM==120000 ;RUG'S MAGIC NUMBER FOR SYMBOL TABLE OFFSETS + +.INSRT SITS;SITSS SYMS + +.SBTTL LOAD MAP +;PAGE 0 +;DDT INSTRUCTION PAGE 0 + +;PAGE 1 +;DDT INSTRUCTION PAGE 1 + +;PAGE 2 +;DDT INSTRUCTION PAGE 2 + +;PAGE 3 +;NOT LOADED + +;PAGE 4 +;DDT IMPURE VARIABLES AND PERMANENT SYMBOL TABLE + +;PAGE 5 +;DDT PURE VARIABLES + +;PAGE 6 +;NOT LOADED + +;PAGE 7 +;NOT LOADED (BECAUSE OF RUG) + + +.SBTTL PAGE MAP +;PAGE 0 +;DDT INSTRUCTION PAGE 0 +PAG0A==0 +PURINS=PAG0A + +;PAGE 1 +;DDT INSTRUCTION PAGE 1 +PAG1A==20000 + +;PAGE 2 +;DDT INSTRUCTION PAGE 2 +PAG2A==40000 + +;PAGE 3 +;NOT USED +PAG3A==60000 + +;PAGE 4 +;NOT USED +PAG4A==100000 + +;PAGE 5 +;NOT USED +PAG5A==120000 + +;PAGE 6 +;NOT USED +PAG6A==140000 + +;PAGE 7 +;NOT USED +PAG7A==160000 + +;PAGE 10 +;SYMBOL PAGE 4 (IF NEEDED) + +;PAGE 11 +;SYMBOL PAGE 3 (IF NEEDED) + +;PAGE 12 +;SYMBOL PAGE 2 (IF NEEDED) + +;PAGE 13 +;SYMBOL PAGE 1 (IF NEEDED) + +;PAGE 14 +;USED FOR DDT'S IMPURE VARIABLES,PERMANENT SYMBOL TABLE, AND START OF SYMBOLS +IMPVAR==PAG4A + +;PAGE 15 +;USED FOR DDT'S PURE VARIABLES +PURVAR==PAG5A + +;PAGE 16 +;USED FOR MAPPING IN THE INFERIORS SPHERE + +;PAGE 17 +;USED FOR BUFFER FOR DISK TRANSFERS + + +.SBTTL MACROS +.MACR INISYM +HKWORD==0 +RGWORD==0 +SYMBIT==1 +.ENDM + +.MACR DEFSYM S1,S2,VAL,REG,HKILL +.=.-6 + .RAD50 /S1/ + .RAD50 /S2/ + VAL +.=.-6 +.IFNB REG +RGWORD==RGWORD+SYMBIT +.ENDC +.IFNB HKILL +HKWORD==HKWORD+SYMBIT +.ENDC +.IFZ SYMBIT-1 +LSTSY==LSTSY-<2*<2+<20*3>>> +.ENDC +SYMBIT=2*SYMBIT +.IFZ SYMBIT +.=LSTBEG-4 + HKWORD + RGWORD +INISYM +LSTBEG==LSTBEG-<2*<2+<20*3>>> +.=LSTBEG-4 + +.ENDC +.ENDM + +.MACR ENDSYM +.IFNZ SYMBIT-1 +.=LSTBEG-4 + HKWORD + RGWORD +.ENDC +.ENDM + +.MACR DEFOP NAME,VALUE + .RAD50 /NAME/ +.IFLE .LENGTH NAME,-3 + 0 +.ENDC + VALUE +.ENDM + +.MACR OPBLK TYPIN,TYPOUT,MASK + 0 + TYPIN + TYPOUT + MASK +.ENDM + +ASCLEN==0 ;NO ASCII LENGTH YET + +ASCLOC==ASCBUF ;START GENERATING ASCII CODES AT ASCBUF +;MISCELLANEOUS CODE GENERATING MACROS +.MACR TYPEIT STR +ASCLEN==ASCLEN+.LENGTH ^ÓTR¬+1 + MOV #ASCLOC,-(P) + JSR PC,TYPSTR +.IF2 +FOO==. +.=ASCLOC +.ASCIZ ÓTRŠ ASCLOC==. +.=FOO +.ENDC +.ENDM + +.INSRT SITS;SITMAC > + +;MACRO FOR DELETING CAPABILITIES USING DELCP +.MACRO DELCAP CAP +MOV CAP,A +JSR PC,DELCP +CLR CAP +.ENDM + +;SYSTEM CALL MACROS + +;MACRO FOR ERROR RETURNS FROM SYSTEM CALLS +.MACRO ERROR STRING,LOC,ARGPOP +.IF B LOC +JMPLEN==0 +.IFF +JMPLEN==4 +.ENDC +.IF NB ARGPOP +JMPLEN==JMPLEN+4 +.ENDC +.IF B STRING +STLEN==0 +.IFF +STLEN==10 +.ENDC + BNE .+2+JMPLEN+STLEN +.IIF NB STRING, TYPEIT +.IIF NB ARGPOP, ADD #2*ARGPOP,P +.IIF NB LOC, JMP LOC +.ENDM + +;FATAL SYSTEM CALL ERROR FOR DDT +.MACRO ERRORB + BNE .+4 + BPT +.ENDM +;SYSTEM CALL MACROS +.MACRO MMAP A,B,C,D,E,F,G + SAVE F + MOVB G,1(P) + SAVE E + SAVE C + MOVB D,1(P) + SAVE A + BIS B,(P) + .MAP +.ENDM + +.MACRO $MMAP A,B,C,D,E,F,G + SAVE F + MOVB G,1(P) + SAVE E + SAVE C + MOVB D,1(P) + SAVE A + BIS B,(P) + $MAP +.ENDM + +.MACRO INVOK. CAP,FUNCTION,ARG2,ARG3 +.IF B ARG3 + .IF B ARG2 + CMP -(P),-(P) + .IFF + TST -(P) + SAVE ARG2 + .ENDC +.IFF + SAVE ARG3 + .IF B ARG2 + TST -(P) + .IFF + SAVE ARG2 + .ENDC +.ENDC +SAVE CAP +.IIF NB FUNCTION, BIS FUNCTION,(P) + .INVOK +.ENDM + + +.SBTTL VARIABLES + +SYMBEG==IMPVAR+4000 ;BEGINNING IF THE SYMBOL TABLE +SYMLIM==0 ;BOTTOM LIMIT OF SYMBOL TABLE +.=SYMBEG ;THESE SIT ON TOP OF THE SYMBOL TABLE +;INFERIOR SPHERE AND PROCESS VARIABLES +UA: .BLKW 6 ;USER A-F, REGISTER SET 0 +UP: 0 ;USER R6 +UPC: 0 ;USER PC +UST: 0 ;USER'S SAVED ST +UFPST: 0 ;USER'S SAVED FLOATING POINT PROCESSOR STATUS +FAC0: .BLKW 4*6 ;FLOATING POINT PROCESSOR ACS + .BLKW 20 + +FAPAVF: 0 ;SET TO 1 BY SAVEST IF FLOAT AVAILABLE TO THIS PROCESS +PFAULT: 0 ;PROCESS FAULT WORD +PERRW: 0 ;PROCESS ERROR WORD +PERRA: 0 ;PROCESS ERROR ADDRESS +PRSYMS==. ;END OF THE PROCESSES SYMS + +BPTADR: .BLKW NBPTS ;ADDRESS OF BREAKPOINT. ZERO IS NO BREAKPOINT +SSADR: 0 +BPTCNT: .BLKW NBPTS ;BREAKS WHEN COUNTED NON-POSITIVE +SSCNT: 0 +BPTINS: .BLKW NBPTS ;INSTRUCTIONS WHERE BREAKPOINTS LIVE +SSINS: 0 +BPTLOC: .BLKW NBPTS ;LOCATION TO TYPE UPON HITTING BREAKPOINT (IF BPTREG0) +SSLOC: 0 +BPTRGF: .BLKW NBPTS ;REGISTER (LT 0) AND BPTLOC VALID ( 0) FLAGS +SSRGF: 0 + +;DDT VARIABLES +RSTART: 0 ;SET TO NON-ZERO WHEN IT DDT HAS BEEN RESTARTED ALREADY +PDUMPD: 0 ;SET TO NON-ZERO WHEN THIS HAS BEEN PDUMPDED +SYMBOT: PAG4A ;BOTTOM OF THE SYMBOL TABLE +.IFNZ LSI +MEMT: 0 ;TOP OF THE LSI'S MEMORY +WATJMP: 0 ;PLACE TO JUMP WHEN FINISHED IF INTERUPTED BY TTY +.ENDC +SVUPC: 0 ;UPC SAVED HERE ON $X +XCTLOC: 0 ;THIS IS WHAT THE PC SHOULD BE IF WE ENTER FROM $X +MASK: -1 ;THIS IS $M +CMASK: 0 ;COMPLEMENT OF MASK +TARGET: 0 ;COPY OF THING TO SEARCH FOR AT SRCH +USRBEG: 0 ;LOWER LIMIT OF SEARCH OR ZERO (DEFAULT) +USREND: 177777 ;UPPER LIMIT OF SEARCH OR ZERO (DEFAULT) +POWER: 0 ;POWER OF 10 TO MULTIPLY BY +EVSIZE: 0 ;HIGH BYTE NONZERO MEANS LOW BYTE VALID + ;LOW BYTE 0 FOR INTEGER, NONZERO FOR FLOATING +REGWAD: 0 ;ADDRESS IN SYM TABLE OF RELEVANT REGISTER WORD +MXOFF: 200 ;MAXIMUM OFFSET TO USE IN SYMBOLIC TYPEOUT +SYTYAD: 0 ;ADDRESS OF BEST SYMBOL FOUND IN SYTYPE +LFINC: 2 ;AMOUNT TO INCREMENT . BY ON A LF +INS1: 0 ;INSTRUCTION STORED HERE ON TYPEIN FROM EVAL +INS2: 0 ;IT IS ASSEMBLED AS IF THE ADDRESS OF THE FIRST +INS3: 0 ;WORD OF THE INSTRUCTION WAS ZERO +XCTBPL: BPTOP ;MUST FOLLOW INS1-3 +INP: INS2 ;POINTER TO INS2 AND 3 +INREL: 0 ;RELOCATION INFO FOR INS2-3. LOW BYTERELOCATE INS2 + ;HIGH BYTERELOCATE INS3 +INRELP: 0 ;POINTER TO INREL OR INREL+1 +SSDDPC: 0 ;PC FOR SSORDD +ALTPV: 0 ;VALUE IN PARENS AFTER ALT +FTEMP: .BLKW 4 ;TEMPORARY DURING FLOATING POINT TYPEOUT +T1: 0 ;VERY TEMPORARY +T2: 0 ;VERY TEMPORARY + +SYM: 0 ;ACCUMULATE 2 WORDS OF RADIX 50 +SYM1: 0 +SYM2: 0 ;FOR OVERFLOW FROM SYM1 + +FLT1: 0 ;TEMPORARY FOR STORING DOUBLE FLOATING RESULTS + 0 + 0 + 0 + +TVAL: 0 + +VAL1: 0 +VAL2: 0 +VAL3: 0 +VALP: VAL1 +VALRF: 0 + +LVAL: 0 ;VALUE STORED HERE BY EVAL, SEE LVREGF, LVFLTF +LFVAL: .BLKW 4 ;FLOATING VALUE STORED HERE, " +OPLOC: 0 ;CURRENTLY OPEN LOCATION +INSLOC: 0 ;ADDRESS OF INSTRUCTION BEING TYPED OUT +INSVAL: 0 ;FIRST WORD OF INSTRUCTION BEING TYPED +LSTADR: 0 ;LAST ADDRESS TYPED OUT +PLSTAD: 0 ;PREVIOUS LSTADR + +.=.+100 +OPPDL: +.=.+300 +VALPDL: + +.=.+LPDL +PDL: + ;FLAGS AND MODES +;THE FOLLOWING TWO BYTES MUST BE IN THE SAME WORD +SYMF: .BYTE 0 ;NON-NUMERIC RESULT FROM GETTOK +NUMF: .BYTE 0 ;NUMBER HAS BEEN SEEN IN GETTOK +;THE FOLLOWING TWO BYTES MUST BE IN THE SAME WORD +EXSYMF: .BYTE 0 ;SYMBOL FLAG FROM EXPR +EXNUMF: .BYTE 0 ;NUMERIC FLAG FROM EXPR + +NUMOM: .BYTE 0 ;NUMBERS ONLY MODE IN GETTOK +DIGITS: .BYTE 0 ;COUNT OF DIGITS IN GETTOK +FLTF: .BYTE 0 ;FLOATING VALUE IN FLT1 FTL2 +FLUSHF: .BYTE 0 ;FLUSH ALL NON-SEPARATORS +NEGEXF: .BYTE 0 ;SET WHEN E- SEEN +EVNOVF: .BYTE 0 ;INDICATES EVAL DOESN'T WANT A VALUE NEXT +POPF: .BYTE 0 ;INDICATE UNWINDING OP STACK +EVREGF: .BYTE 0 ;VALUE IN EVAL IS A REGISTER VALUE +EVINSF: .BYTE 0 ;VALUE IN EVAL IS AN INSTRUCTION (IN INS1 - INS3) +EVINSC: .BYTE 0 ;NUMBER OF WORDS IN INSTRUCTION IF EVINSF SET +EVINLF: .BYTE 0 ;LEFT PAREN IN INSTRUCTION TYPEIN FLAG +FDIGCT: .BYTE 0 ;DIGIT COUNTER IN FTYPE +SYTYRF: .BYTE 0 ;NONZERO IF SYTYPE TO TYPE REGISTER VALUE +SYMADF: .BYTE 0 ;NONZERO IF TYPING ADDRESS AT SYTYPE +INSSDD: .BYTE 0 ;GETSD ASSEMBLES THE ADDRESSING MODE AND REGISTER HERE +SALTNM: .BYTE 0 ;VALUE AFTER ALT SAVED HERE +ALTVF: .BYTE 0 ;SET IF A VALUE AFTER ALT SAVED I SALTNM +ALTPVF: .BYTE 0 ;SET IF VALUE IN PARENS GIVEN AFTER ALT +ALPVRF: .BYTE 0 ;VALUE IN PARENS AFTER ALT IS REG VALUE +T1B: .BYTE 0 ;VERY TEMPORARY +T2B: .BYTE 0 ;VERY TEMPORARY +PROGF: .BYTE 0 ;SET IF WE DON'T NEED TO RESTORE THE STATE OF THE MACHINE + .EVEN + +;THE ORDER OF THE TEMPORARY AND PERMANENT TYPEOUT MODES MUST NOT BE CHANGED + +;TYPEOUT MODES - TEMPORARY +BYTEMD: .BYTE 0 +HALFMD: .BYTE 0 ;TWO BYTES SEPARATED BY COMMAS +INSTMD: .BYTE 1 ;INSTRUCTION MODE +SYMBMD: .BYTE 0 ;TYPE SYMBOLS +FLTYMD: .BYTE 0 ;TYPE FLOATING POINT NUMBERS +TXTMD: .BYTE 0 ;TYPE AS 2 CHAR ASCII +TXT5MD: .BYTE 0 ;TYPE AS 3 CHAR RADIX 50 +DECMD: .BYTE 0 ;NUMBERS TYPED IN DECIMAL +ABSMD: .BYTE 0 ;ABSOLUTE MODE (AS OPPOSED TO RELATIVE) + .EVEN + +;TYPEOUT MODES - PERMANENT +PBYTEM: .BYTE 0 +SPHALFM: .BYTE 0 ;TWO BYTES SEPARATED BY COMMAS +PINSTM: .BYTE 1 ;INSTRUCTION MODE +PSYMBM: .BYTE 0 ;TYPE SYMBOLS +PFLTYM: .BYTE 0 ;TYPE FLOATING POINT NUMBERS +PTXTMD: .BYTE 0 ;TYPE AS 2 CHAR ASCII +PTXT5M: .BYTE 0 ;TYPE AS 3 CHAR RADIX 50 +PDECMD: .BYTE 0 ;NUMBERS TYPED IN DECIMAL +PABSMD: .BYTE 0 ;ABSOLUTE MODE (AS OPPOSED TO RELATIVE) + .EVEN + +;THE NEXT TWO ARE PERMANENT ALWAYS +FLTIMD: .BYTE 1 ;FLOATING POINT INSTRUCTION TYPEOUT +DBLFMD: .BYTE 0 ;DOUBLE PRECISION FLOATING POINT + +SNEAK1: .BYTE 0 ;STYI PUTS BYTE HERE FOR TYI TO READ +SNEAK2: .BYTE 0 ;TYI CHECKS HERE AFTER CHECKING SNEAK1 +LVREGF: .BYTE 0 ;LAST VALUE'S REGISTER FLAG +LVFLTF: .BYTE 0 ;LAST VALUE WAS FLOATING +OPENWD: .BYTE 0 ;0NOT OPEN, 1BYTE OPEN, 2WORD OPEN +OPLORF: .BYTE 0 ;OPLOC IS A REGISTER +LSTADG: .BYTE 0 ;LSTADR IS A REGISTER +PLSADG: .BYTE 0 ;PLSTAD IS A REGISTER +PROCF: .BYTE 0 ;NON-ZERO=>OK TO PROCEED (INDEX OF LAST BPT) +LBPTN: .BYTE 0 ;LAST BPT INDEX +A2PF: .BYTE 0 ;$$P FLAG +DDTINI: .BYTE 0 ;NON-ZERO AFTER DDT HAS RUN THE FIRST TIME +BRKFL: .BYTE 0 ;SET BY LEFT BRACKET CLEARED AT EVAL +SRCHTY: .BYTE 0 ;1EFF ADDR, -1NOT WORD, 0WORD SEARCH + .EVEN + +;STORAGE FOR THE I/O MODIFICATIONS +CURSOR: .WORD 0 ;OUTPUT COLUMN +RESETF: .WORD 0 ;FLAG INDICATES QUIT COMMAND AND GET NEW +TYOFLS: .WORD 0 ;FLUSH TYPEOUT WHILE THIS FLAG IS SET + +;PDL FOR THE INTERRUPT PROCESS + .BLKW 10 +INTPDL: + +;MISC CHAR BUFFERS +TYIBUF: .BLKW 100 ;THE RUBOUT BUFFER +ETYIBF:: ;END OF THE BUFFER +TYIPNT: TYIBUF ;POINTER TO WHERE CHARS ARE INSERTED INTO TYIBUF +CTYIPT: TYIBUF ;POINTER TO WHERE CHARS ARE TAKEN OUT OF TYIBUF + + +;STORAGE FOR CAPABILITY INDEX POINTERS +CRCAP==0 ;C-LIST INDEX FOR THE CREATE CAPABILITY +MYSPHR==1 ;C-LIST INDEX FOR DDT'S SPHERE +TTICAP==2 ;C-LIST INDEX FOR INPUT STREAM CAPABILITY +TTOCAP==3 ;C-LIST INDEX FOR OUTPUT STREAM CAPABILITY +DEFCAP==4 ;C-LIST INDEX FOR DEFAULT DIRECTORY CAPABILITY +ROOTCP==10 +SPHCAP: 0 ;C-LIST INDEX FOR THE SPHERE DDT IS DEBUGGING +PRCAP: 0 ;C-LIST INDEX FOR THE PROCESS THAT DDT IS OPERATING UPON +FILCAP: 0 ;C-LIST INDEX FOR THE FILE CONTAINING THE PROGRAM BEING DEBUGGED +FILCP1: 0 ;C-LIST INDEX FOR THE FILE TO BE COPIED FROM +DDTLOK: 0 ;C-LIST INDEX FOR THE QU LOCK FOR DDT +CLINK: 0 ;C-LIST INDEX FOR THE CORE LINK TO INTERRUPT LEVEL PROCESS +TMPCAP: 0 ;C-LIST INDEX FOR A TEMPORARY CAPABILITY +.IIF NZ LSI,LSICAP: 0 ;C-LIST INDEX FOR THE LSI TTY + +;STORAGE FOR THE SPACE MODIFICATIONS +SPACMD: .BYTE 0 ;CURRENT SPACE MODE (I,D,UPT,SYS,...) +;MODES ARE: +IMOD==0 ;REFERENCES TO I SPACE +DMOD==1 ;REFERENCES TO D SPACE +SYMOD==2 ;REFERENCES TO ABSOLUTE PAGES +BMODES==SYMOD+1 ;THE FOLLOWING ARE INCREMENT . BY 1 MODES ALWAYS +CPMOD==3 ;CAPABILITY MODE +MPMOD==4 ;PRINT OUT UPT INFORMATION + +PSPCMD: .BYTE 0 ;SIMILAR TO SPACMD +CURPAG: -1 ;CONTAINS THE PAGE NUMBER IN THE SPHERE WHICH DDT IS REFERENCING + ;TOPY BIT IS SET IF ABSOLUTE PAGE +SPHMAP: .BLKW 20 ;CONTAINS THE PAGE MAP OF THE SPHERE BEING DEBUGGED + +;LOADER VARIABLES +LODSMP: .BLKB 8. ;PAGE MAP +LODPA: -1 ;PAGE CURRENTLY IN MY MAP OF INFERIOR SPHERE +SYMBLK: 0 ;CONTAINS THE NEXT FILE BLOCK TO BE READ BY LOADER +SYMPAG: 0 ;THE PAGE OF THE NEXT FILE BLOCK +BUFPAG==17 ;WE MAP THE SPHERE INTO BUFPAG, ALSO USED BY ALT Y +BUFADR==160000 ;ADDRESS OF BUFPAG +MAPOFF==2 ;OFFSET OF MAP IN MAP PAGE OF PURE FILE +MSADDR==42 ;BYTE OFFSET OF STARTING ADDRESS +SPARTL==44 ;BYTE OFFSET OF SYMBOL PART LENGTH WORD +SFILP1==46 ;BYTE OFFSET OF SYMBOL PART FILE POINTER (HIGH ORDER) +SFILP2==50 ;BYTE OFFSET OF SYMBOL PART FILE POINTER (LOW ORDER) +SADDR: 1 ;ODD TO MAKE SURE WE INITIALIZE +SYMEND: LSTSY ;CONTAINS THE CURRENT END OF SYMBOL TABLE +SYMBAS: LSTSY ;BASE ADDRES FROM WHICH THE NEW SYMBOL GROW DOWN + +CMDLIN: .BLKB 100. ;THE COMMAND LINE OF THE CURRENT PROCESS +CMDLEN==100. +STRBUF: .BLKB 100. ;BUFFER FOR STRING FUNCTIONS +SBFLEN==100. ;CAN BE 100 BYTES LONG + +;MAPPING CONSTANTS +MAPPAG==16 ;DDT USE THIS PAGE FOR LOADER AND ADDRESS MAPPING +MAPADR==PAG6A ;ADDRESS OF THE MAP PAGE. +MPMSK1==160000 ;BIC MASK FOR THE USER'S ADDRESS +MPMSK2==PAG6A ;BIS MASK FOR THE USER'S ADDRESS + +;ALT Y VARIABLES AND CONSTANTS +BLEN==1024. ;BUFFER LENGTH IS 1024, CAN BE CHANGED +CNTPTR: 0 ;CONTAINS A POINTER TO THE BLOCK COUNT OF CURRENT LOADER BLOCK +BCNT: 0 ;CONTAINS THE COUNT IN BYTES OF THIS LOADER BLOCK +CHKSUM: 0 ;THE CHECKSUM FOR THIS LOADER BLOCK +SPAG: 0 ;THE CURRENT SOURCE PAGE (PROGRAM DATA ONLY) +SYMFLG: 0 ;WHEN SET, INDICATES WE ARE NOW MOVING SYMBOLS +TAPLEN: 14000 ;LENGHT OF EACH TAPE +TAPLEF: -1 ;AMOUNT LEFT TO PUNCH (IF < 0 NOT PUNCHING) + +TIME: 0 +DATE: 0 +;FILENAME AND DIRECTORY VARIABLES +DIRNAM: .BYTE '. ;INITIAL DIRECTORY IS . + .BYTE 0 ;INITIAL ZERO FOR ASCIZ FORMAT + .BLKB 38. + .EVEN +DNLEN==40. ;DIRECTORY NAME CAN BE 40 BYTES LONG +FILNAM: .BYTE 0 ;NO INITIAL FILE NAME + .BLKB 24. + .EVEN +FNLEN==25. ;FILENAME CAN BE 25 BYTES LONG + +FLSLEN==25. ;STRING BUFFER FOR FILE OPERATIONS +FILSTR: .BLKB FLSLEN-1 + .BYTE 0 + .EVEN + +FILFLG: .WORD 0 ;SAVE FLAGS CAPABILITY FLAGS OF FILE +MFIFLG: .WORD 0 ;MFI FLAGS FOR FILE. MUST FOLLOW FILFLG + +STATS: .BLKW 20 ;SITS VERSION # AND STIME + +;STORAGE FOR MORE BREAK PROCESS +MFLUSH: .WORD 0 ;FLUSH OUTPUT FLAG +BRPRCP: .WORD 0 ;CAPABILITY OF THE BREAK PROCESS + .BLKW 10 +MPDL: ;BREAK PROCESS PDL +.IFNZ LSI + .BLKW 10 +WATPDL: ;TTY WAIT PDL FOR LSI +.ENDC + +;VARLIM MARKS THE END OF DDT'S VARIABLE PAGE +VARLIM==. +VARLEN==/2000 ;LENGTH OF THE IMPURE VARIABLE PAGE +.IIF GT VARLIM-IMPVAR-20000,.ERROR IMPURE VARIABLE AREA OVERFLOW + +.=SYMBEG + +INISYM +LSTSY==SYMBEG +LSTBEG==SYMBEG +.=.-4 +DEFSYM .,,0,,HKILL +DOTVAL=.+4 +DOTRGW=DOTVAL+4 ;WORD CONTAINING REGISTER BIT (LOW ORDER) FOR DOT +DEFSYM %0,,0,REG,HKILL +DEFSYM %1,,1,REG,HKILL +DEFSYM %2,,2,REG,HKILL +DEFSYM %3,,3,REG,HKILL +DEFSYM %4,,4,REG,HKILL +DEFSYM %5,,5,REG,HKILL +DEFSYM %6,,6,REG,HKILL +DEFSYM %7,,7,REG,HKILL +DEFSYM %PS,,</2>,REG,HKILL +DEFSYM %SA,DDR,</2>,REG,HKILL +DEFSYM %AC,0,</2>,REG,HKILL +DEFSYM %AC,1,</2>,REG,HKILL +DEFSYM %AC,2,</2>,REG,HKILL +DEFSYM %AC,3,</2>,REG,HKILL +DEFSYM %AC,4,</2>,REG,HKILL +DEFSYM %AC,5,</2>,REG,HKILL +DEFSYM %FP,S,</2>,REG,HKILL +DEFSYM %CU,RPA,</2>,REG,HKILL +DEFSYM %LV,AL,</2>,REG,HKILL +DEFSYM %PR,CAP,</2>,REG,HKILL +DEFSYM %FI,LCA,</2>,REG,HKILL +DEFSYM %P,HCA,</2>,REG,HKILL +DEFSYM %MX,OFF,</2>,REG,HKILL +DEFSYM %PF,AUL,</2>,REG,HKILL +DEFSYM %PE,RRW,</2>,REG,HKILL +DEFSYM %PE,RRA,</2>,REG,HKILL +DEFSYM %SY,MEN,</2>,REG,HKILL +DEFSYM %OP,LOC,</2>,REG,HKILL +DEFSYM %IN,SLO,</2>,REG,HKILL +DEFSYM %TA,RGE,</2>,REG,HKILL +DEFSYM %US,RBE,</2>,REG,HKILL +DEFSYM %US,REN,</2>,REG,HKILL +ENDSYM + + +.SBTTL MAIN COMMAND LOOP + +.=PURINS +PURIFY: MOV #PDL,P + JSR PC,MAPSET + MOV PC,PDUMPD ;WE SHOULD BE PDUMPED + BPT ;TELL HIM WE ARE READY TO GO + +DDT: MOV #PDL,P + $FLOAT ;FLOATING POINT + LDFPS #40200 ;FLOATING DOUBLE, ROUND, SHORT INTEGERS + SAVE #TTICAP ;GET THE TTY + $TTGET ;GIMME + TST RSTART ;ARE WE BEING RESTARTED? + BNE RESTRT ;YES, IGNORE THE REGISTERS AND OTHER CRUFT + MOV PC,RSTART ;SET FLAG + MOV A,PRCAP ;IF WE ARE CALLED WITH A PROCESS + MOV B,SPHCAP ;IF WE ARE CALLED WITH A SPHERE + TST PDUMPD ;ARE WE PDUMPED? + BNE RESTRT ;YES, SO WE SHOULD BE ALL SET UP +RESTRT: TST PRCAP ;WAS ANY PROCESS GIVEN TO US? + BEQ DDT1 ;NO + JSR PC,SAVEST ;GET THE REGISTERS + MOVB #10*2,PROCF ;SO THAT WE CAN PROCEED + BR DDT3 ;AND GO TO COMMAND +DDT1: CLRB PROCF ;CAN'T PROCEED FROM HERE +DDT3: CLRB A2PF ;CLEAR $$P FLAG + DELCAP CLINK ;FLUSH ANYTHING IN EXISTENCE + INVOK. #CRCAP,#.CLCAP*400,#30 ;CREATE A CORE LINK + ERRORB + REST CLINK + SAVE #INT + .FORK ;CREATE THE INTERRUPT LEVEL PROCESS + ERRORB + INVOK. CLINK,,#-1 ;MAKE THIS PROCESS THE CONSUMER + ERRORB + DELCAP DDTLOK ;FLUSH ANYTHING CURRENTLY HERE + INVOK. #CRCAP,#.QUCAP*400,#1,#-1 + ERRORB ;FATAL ERROR IF THIS CALL LOSES + REST DDTLOK ;SAVE CAPABILITY INDEX OF THE LOCK + SAVE DDTLOK + .QULK ;ONLY ALLOW 1 PROCESS IN DDT AT A TIME + ERRORB + INVOK. #TTICAP,#<.TTMOV>*400,#.TICVM!.TIMGI!.TICTM ;SET TTY STATUS TO DDT + ERROR + INVOK. #TTICAP,#.TTTYP*400 + ERRORB ;FOO, THIS SHOULDN'T BE NEEDED + BIT #200,(P)+ ;IS IT A TV? + BEQ 1$ ;NO,FORGET IT + INVOK. #TTICAP,#.TVFNT*400,#1 ;SET TO SMALL FONT + ERRORB +1$: JSR PC,CRLF + TYPEIT + MOV #VERNUM,B ;VERNUM IS THE VERSION NUMBER FROM PALX + JSR PC,DTYPE ;TYPE THE VERSION NUMBER IN DECIMAL + TST SPHCAP ;ARE WE DEBUGGING ANYTHING ALREADY? + BEQ CMD ;NO + INVOK. SPHCAP,#<.SPENT*400>,#FAULT ;SET THE FAULT ADDRESS + ERROR + TYPEIT < SPHERE LOADED> +;FALLS INTO CMD + ;CMD IS THE BASIC COMMAND LOOP. FUNCTIONS DISPATCH OFF FROM EVAL +;AND JMP HERE WHEN DONE. +CMD: JSR PC,CRLFS ;TYPE * +CMD4: JSR PC,TRESET ;FLUSH ANY CHARS IN INPUT BUFFER +CMD1: CLR RESETF + CLR VALP + CLR VALRF +CMD3: MOV #PDL,P + JSR PC,EVAL +CMD2: TYPEIT < > + BR CMD4 + +QERR: TYPEIT + BR CMD4 + +FNF: TYPEIT +FILCMD: DELCAP FILCP1 + DELCAP FILCAP + BR CMD + +NXMTRP: TYPEIT < ?NXM? > + BR CMD4 + +BADPR: TYPEIT + BR CMD + +XXXERR: JSR PC,TYO ;TYPE THE ^D + TYPEIT < XXX ? > +.IFNZ LSI + TST LSICAP ;LSI? + BEQ CMD4 + SAVE <,#3,LSICAP> + BIS #.TBRAK*400,(P) ;CAUSE BREAK TO MAKE LSI LISTEN TO US + $INVOK ;SEND IT + SAVE <#15,LSICAP> ;SEND CR + $BYTO + JSR PC,WATLSI ;WAIT FOR THE LSI TO RESPOND +.ENDC + BR CMD4 + +DDTBRK: JSR PC,FLSDEC ;ENABLE TYPEOUT, TYPE ^Z + BPT ;RETURN TO DDT'S SUPERIOR + BR CMD + + +;SET UP THE MAP FOR PDUMPING AND RUNNING FROM THE INITIAL CONFIGURATION +MAPSET: MOV #INSEND,C ;GET NUMBER OF BLOCKS USED IN I-SPACE + CLR A ;CURRENT PAGE + MOV #7*400,F ;SIZE OF A FULL PAGE +MAPST2: CMP C,#10 ;A FULL PAGE LEFT? + BHIS 1$ ;YES + MOV C,F ;COPY LENGTH + DEC F ;DECREMENT THE LENGTH + SWAB F ;LENGTH IN TOP BYTE +1$: SAVE + MOVB A,3(P) ;SET IN THE PAGE NUMBER + ADD #20*400,2(P) ;MUST CHANGE BOTH I AND D PAGES + $MAP ;BETTER NOT FAIL + INC A ;POINT TO THE NEXT PAGE + SUB #10,C ;FOR THE NEXT PAGE + BGT MAPST2 ;MORE PAGES TO GO + MOV #14,B ;THE FIRST PAGE WE WANT TO STAY + SUB A,B ;GET THE NUMBER OF PAGES TO DELETE +MAPST1: JSR PC,PAGDEL ;DELETE THE PAGES + MOV #VARLEN,C ;THE LENGTH OF THE VARIABLE PAGE + DEC C ;ONE LESS + SWAB C ;BECAUSE LENGTH IS IN TOP BYTE + SAVE ;IMPURE VARIABLES READ-WRITE + MOVB A,3(P) ;SET IN PAGE NUMBER + $MAP ;SHORTEN THE PAGE + INC A ;NOW TO THE PURE VARIABLES + MOV #PURLEN,C ;GET THE LENGHT + DEC C + SWAB C ;INTO SOMETHING MAP LIKES + SAVE + MOVB A,3(P) ;SET IN PAGE NUMBER + $MAP ;SHORTEN AND READ-PROTECT PURE VARIABLES + INC A ;TO THE TOP TWO PAGES... + MOV #2,B ;BOTH OF THEM + JSR PC,PAGDEL ;DELETE THEM + RTS PC + +PAGDEL: CMP -(P),-(P) ;NOT USED IN DELETE + SAVE #-3 ;DELETE FUNCTINO + MOVB A,1(P) ;THE PAGE NUMBER + SAVE #MYSPHR ;THIS SPHERE + $MAP ;BETTER NOT FAIL + INC A + SOB B,PAGDEL ;ALL THE PAGES + RTS PC + + ;SAVEST +;SAVEST SAVE THE REGISTERS, PS AND IF AVAILABLE, THE FLOATING POINT STUFF +;OF THE PROCESS INVOKED BY PRCAP IN A PLACE WHERE DDT CAN ACCESS THEM. +;IT ALSO PUTS INSTRUCTIONS BACK WHERE BREAKPOINTS WERE. + +SAVEST: SAVE #TTICAP + .TTGET ;GET BACK THE TTY + ERRORB ;FATAL ERROR IF THIS FAILS + .FLOAT + ERRORB + TST SPHCAP ;IS THERE ANYTHING IN THE SPHERE? + ERROR ,SAVER1 ;NO + SAVE <#SPHMAP,SPHCAP> + .RDMAP ;RESET THE PAGE MAP + ERROR ,SAVER1 + JSR PC,BPTRST ;PUT INSTRUCTIONS BACK +SAVES1: MOV PRCAP,A ;GET THE PROCESS TO BE INVOKED + ERROR ,SAVER2 ;NOTHING IN PRCAP + INVOK. PRCAP,#.PRFAUL*400 ;READ THE PROCESS FAULT WORD + ERROR ,SAVER2 + REST PFAULT ;SAVE IN PFAULT (ACCESSIBLE VIA CONSOLE) + INVOK. PRCAP,#.PRERR*400 ;READ THE PROCESS ERROR WORD + ERROR ,SAVER2 ;COULDN'T READ IT + REST PERRW ;SAVE IN PERRW + INVOK. PRCAP,#.PRERA*400 ;READ THE PROCESS ERROR ADDRESS + ERROR ,SAVER2 ;FAILED + REST PERRA ;SAVE IT AWAY + BIS #.PRREG*400,A ;FUNCTION IS TO READ THE REGISTERS + MOV #UA,B ;THE REGISTERS AND PS ARE SAVED IN CONSECUTIVE + ;LOCATIONS STARTING AT UA. +SAVLP1: SAVE <#0,#0,A> ;GET THE REGISTER POINTED TO BY + .INVOK ;THE TOP BYTE OF THE FIRST ARGUMENT, INTIALLY, 0 + ERROR ,SAVER2 ;THE OTHER TWO ARGUMENTS ARE DUMMIES + REST (B)+ ;SAVE THE REG'S IN DDT'S STORAGE + ADD #400,A ;INCREMENT THE TOP BYTE TO POINT TO NEXT REG FOR IVK + CMP #UST,B ;HAVE WE GOTTEN ALL THE REGISTERS YET? + BGE SAVLP1 ;LOOP UNTIL WE HAVE + SAVE <#0,#0,PRCAP> ;GET READY FOR ANOTHER INVOKE + BIS #.PRFPE*400,(P) ;TOP BYTE 20 MEANS CHECK THE FLOATING PT AVAILABILITY + .INVOK ;THIS IVK RETURNS 1 IF FLOAT AVAILABLE, 0 ELSE + ERROR ,SAVER2 + MOV (P)+,FAPAVF ;CHECK FLOATING POINT AVAILABILITY AND SET FLAG + BEQ SAVES2 ;NOT AVAILABLE, ERROR TO TRY TO SAVE FLT STUFF + MOV PRCAP,A ;REINITIALIZE A + BIS #.PRFREG*400,A ;FUNCTION IS TO READ THE FLOAT REGISTERS + MOV #FAC0,B ;FAC0 IS THE START OF DDT'S FLOAT SAVE LOCATIONS +SAVLP2: SAVE <#0,B,A> ;SECOND ARG IS A POINTER TO DDT'S SAVE LOCATION + .INVOK ;REMEMBER THAT A CONATAINS PRCAP IN LOW, #11 IN HIGH + ERROR ,SAVER2 + ADD #10,B ;FLOATING POINT REGISTERS ARE SAVED IN 4 WORD BLOCKS + ADD #400,A ;KEEP INCREMENTING THE HIGH BYTE TO GET REST OF REG'S + CMP #FAC0+<5*10>,B ;HAVE WE SAVED ALL THE FLOATING POINT REGISTERS? + BGE SAVLP2 ;NO, LOOP UNTIL WE HAVE + SAVE <#0,#0,PRCAP> ;HIGH BYTE OF A NOW CONTAINS 17 + BIS #.PRFPST*400,(P) + .INVOK ;THIS MEANS GET THE FLOATING POINT STATUS + ERROR ,SAVER2 + REST UFPST ;POP INTO FLOATING POINT STATUS SAVE LOC IN DDT +SAVES2: LDFPS #40200 ;FLOATING DOUBLE, ROUND, SHORT INTEGERS + MOV #2,LFINC ;SET THE LINEFEED INCREMENT TO 2 + JSR PC,RSTMD ;COPY PERMANENT MODES TO TEMPORARIES + RTS PC + +SAVER1: TYPEIT + CLR SPHCAP + BR SAVES1 + +SAVER2: TYPEIT + BR SAVES2 + ;RESTST GIVES BACK THE PROCESS'S REGISTERS AND TTY +;CLOBBERS DDT REGISTERS A AND B +RESTST: MOV PRCAP,A ;GET THE CAPABILITY INDEX OF THE PROCESS + ERROR ,BADPR ;MAKE SURE WE HAVE SOMETHING IN PRCAP + BIS #<.PRWRT+.PRREG>*400,A ;WRITE INTO THE REGISTERS + MOV #UA,B ;UA IS THE START OF THE REG SAVE LOCS IN DDT +RESLP1: SAVE <#0,(B)+,A> ;ARG 1 IS DUMMY, ARG 2 POINTER TO SAVE LOC + .INVOK ;ARG 3 IS REG#,WRITE BIT IN HIGH, PRCAP IN LOW + ERROR ,BADPR + ADD #400,A ;INCREMENT HIGH BYTE TO INVOKE THE NEXT REGISTER + CMP #UST,B ;HAVE WE RESTORED ALL THE REGISTERS AND PS? + BGE RESLP1 ;LOOP UNTIL WE HAVE + SAVE <#0,FAPAVF,PRCAP> ;WRITE THE FLOATING POINT AVAILABILITY FLAG + BIS #<.PRWRT+.PRFPEN>*400,(P) + .INVOK ;NOTICE THAT WE ALWAYS WRITE THE FLAG BACK + ERROR ,BADPR ;SINCE DDT MAY HAVE CHANGED THE FLAG + TST FAPAVF ;WAS THE FLAG SET + BEQ RESTS1 ;NO, THUS DO NOT TRY TO RESTORE FLOATING POINT STUFF + MOV PRCAP,A ;WRITE THE FLOAT REGISTERS BACK + BIS #<.PRWRT+.PRFREG>*400,A + MOV #FAC0,B ;SET B TO LOCATION OF FIRST SAVED FLOATING REG +RESLP2: SAVE <#0,B,A> ;HIGH BYTE OF A INITIALLY CONTAINS 11 + .INVOK ;RESTORE A FLOATING POINT REGISTER + ERROR ,BADPR + ADD #10,B ;EACH SAVED FLT REG IS 4 WORDS LONG + ADD #400,A ;INCREMENT HIGH BYTE TO INVOK THE NEXT REG + CMP #FAC0+<5*10>,B ;HAVE WE RESTORED ALL THE FLOATING REGISTERS YET? + BGE RESLP2 ;LOOP UNTIL WE HAVE + SAVE <#0,UFPST,PRCAP> ;RESTORE THE FLOATING POINT STATUS + BIS #<.PRWRT+.PRFPST>*400,(P) + .INVOK + ERROR ,BADPR +RESTS1: INVOK. PRCAP,#<.PRWRT+.PRERR>*400,PERRW + ERROR ,BADPR + INVOK. PRCAP,#<.PRWRT+.PRFAUL>*400,PFAULT + ERROR ,BADPR + INVOK. PRCAP,#<.PRWRT+.PRERA>*400,PERRA + ERROR ,BADPR + SAVE <#TTICAP,SPHCAP> + .TTGIV ;GIVE THE INPUT STREAM TO USER SPHERE + ERROR ,CMD ;GET A NEW COMMAND + RTS PC + + +.SBTTL EXPRESSION EVALUATOR +;VALUE STACK HAS EITHER FLOATING POINT VALUES OR INTEGER VALUES +;ACCORDING TO EVSIZE BEING NON-ZERO OR ZERO REPECTIVELY. THE +;OP STACK CONTAINS ONE WORD PER VALUE, THE HIGH BYTE HAS THE +;OPERATOR NUMBER AND THE LOW BYTE HAS THE PRECEDENCE. +;OPERATOR OPERATOR NUMBER PRECEDENCE +; ( 1 1 +; + 2 2 +; - 3 2 +; * 4 3 +; ! 5 3 +; - 6 4 (UNARY MINUS) +; ,, 7 0 (BYTE SEPARATOR) +;DURING EVALUATION E POINTS TO THE VALUE STACK F POINT TO THE +;OP STACK, C CONTAINS THE OP NUMBER AND D THE PRECEDENCE + +EVAL: CLRB EVINSF + CLRB EVINLF +EVALI1: MOV #OPPDL,F ;SET UP OP PDL + MOV #VALPDL,E ;SET UP VAL PDL + CLR -(F) ;PUSH INITIAL OP OF 0 WITH 0 PRECEDENCE + CLR EVSIZE + CLRB POPF + CLRB EVREGF + CLRB EVNOVF + CLRB BRKFL +EVALLP: SAVE + JSR PC,EXPR ;READ VALUE AND SEPARATOR + REST +EVALCE: TSTB EXSYMF + BEQ EVALNS + JSR PC,INSTIN +EVALNS: SAVE A + TSTB POPTB(A) + BEQ EVALNP ;NO EVPOP NOW + JSR PC,EVPOP +EVALNP: REST A + TSTB EVINSF + BEQ EVALNI + TSTB INLTB(A) + BGT EVALSD ;SEPARATOR DURING INSTRUCTION + BMI EVERR ;ILLEGAL IN INSTRUCTION +EVALNI: ASL A + JMP @CMDTB(A) ;DIPATCH ON SEPARATOR + + +AP: +APLUS: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS + JSR PC,ANOVAL ;CHECK ON VALUE + TSTB EXNUMF ;SEE IF THERE IS A VALUE + BEQ EVALLP ;IGNORE UNARY PLUS + TSTB EVNOVF ;SEE IF EXPECTING NO VALUE + BNE EVERR ;YES + MOV #2*2,C ;PLUS IS OPERATOR NUMBER 2 +APLUS1: MOV #2,D ;WITH PRECEDENCE 2 +EVALOP: CMPB D,(F) + BLE EVALEV ;NEW PRECEDENCE IS LE OLD - EVALUATE NOW + TSTB EVSIZE+1 ;SEE IF EVSIZE IS DEFINED YET + BNE EVALP1 ;IT IS + INCB EVSIZE+1 + TSTB FLTF ;SEE IF FLOATING + BEQ EVALP1 ;NO + INCB EVSIZE ;YES +EVALP1: TSTB FLTF + BNE EVALP2 ;NEW VALUE IS FLOATING + TSTB EVSIZE ;VALUE IS INTEGER, CHECK TO SEE WE'RE DOING INTEGER CALC + BNE EVERR ;MIXED MODE +ACOMME: MOV B,-(E) ;PUT INTEGER VALUE ON VAL PDL + BR EVALP3 ;GO PUSH OP NOW + +EVALP2: TSTB EVSIZE ;CHECK TO SEE THAT WE ARE IN FLOATING MODE + BEQ EVERR ;MIXED MODE + LDD FLT1,AC0 + STD AC0,-(E) ;PUT DOUBLE FLOATING VALUE ON VAL PDL +EVALP3: MOV D,-(F) ;PUSH NEW PRECEDENCE + MOVB C,1(F) ;AND OPERATOR NUMBER + BR EVALLP + +AMINUS: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS + JSR PC,ANOVAL + TSTB EXNUMF ;SEE IF THERE IS A VALUE + BEQ UMINUS ;UNARY MINUS + MOV #3*2,C ;BINARY MINUS IS OPERATOR NUMBER 3 + BR APLUS1 ;WITH SAME PRECEDENCE AS BINARY PLUS + +AQUOT: MOV #2,C + BR ASTAB +ASTAR: CLR C +ASTAB: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS + JSR PC,ANOVAL + TSTB EXNUMF ;SEE IF THERE IS A VALUE + BEQ EVERR ;NO SUCH THING AS UNARY STAR + ADD #4*2,C ;STAR IS OPERATOR NUMBER 4, ! IS 5 + MOV #3,D ;WITH PRECEDENCE 2 + BR EVALOP + +EVERR: JMP QERR + +UMINUS: MOV #6004,-(F) ;OP 6, PRECEDENCE 4 TO OP STACK + BR EVALLP + +EVALE0: JMP EVALPP +EVALEV: MOV (F)+,A ;POP OFF TOP OF OP STACK INTO A + BEQ EVALE0 ;OVER POPPED OP STACK + SWAB A ;GET OPERATOR NUMBER INTO LOW BYTE + BIC #177400,A ;FLUSH PRECEDENCE + CMP A,#6*2 ;IS IT UNARY MINUS? + BEQ EUMIN ;YES + CMP A,#1*2 ;IS IT LEFT PAREN + BEQ ELPAR ;YES + TSTB EVSIZE + BEQ EVALV1 ;INTEGER MODE + TSTB FLTF + BEQ EVERR ;MIXED MODE + LDD (E)+,AC0 ;TOP OF VALUE STACK +EVALV2: JMP @EVLTB-4(A) ;EVALUATE THE OPERATOR + +EVALV1: TSTB FLTF + BNE EVERR ;MIXED MODE + MOV (E)+,TVAL ;TOP OF VALUE STACK + BR EVALV2 + +EVALSD: SAVE A + JSR PC,EVPOP ;DO EVPOP ON INSTRUCTION SEP REGARDLESS OF POPTB + REST A + TSTB EVSIZE+1 + BEQ EVERR ;NO VALUE GIVEN +EVLSD1: TSTB EVSIZE + BNE EVERR ;FLOATING VALUE GIVEN + RTS PC + +EVALI: JSR PC,EVALI1 + TSTB EVINLF ;IF READING STUFF IN PARENS + BNE EVALIX ;THEN WE'VE GOT IT ALL NOW + SAVE A + JSR PC,EVPOP + REST A +EVALIX: RTS PC + + + +EPLUS: TSTB FLTF + BEQ EPLUS1 ;DO PLUS FOR INTEGER + ADDD FLT1,AC0 +EPLUS3: STD AC0,FLT1 +EPLUS2: BR EVALOP + +EPLUS1: ADD TVAL,B + BR EVALOP + +EMINUS: TSTB FLTF + BEQ EMIN1 ;DO SUBTRACT FOR INTEGER + SUBD FLT1,AC0 + BR EPLUS3 + +EMIN1: NEG B + BR EPLUS1 + +ESTAR: TSTB FLTF + BEQ ESTAB ;DO MULTIPLY FOR INTEGER + MULD FLT1,AC0 + BR EPLUS3 + +ESTAB: MUL TVAL,B + BR EPLUS2 + +EQUOT: TSTB FLTF + BEQ EQUOT1 ;DO DIVIDE FOR INTEGER + TSTD FLT1 + CFCC ;COPY CONDITION CODES + BEQ EVERR ;DON'T DIVIDE BY ZERO + DIVD FLT1,AC0 + BR EPLUS3 + +EQUOT1: TST TVAL + BEQ EVERR ;DON'T DIVIDE BY ZERO + SAVE + CLR A + MOV TVAL,B + DIV (P),A ;DO THE DIVISION. QUOTIENT IN A + TST (P)+ + MOV A,B ;QUOTIENT TO B + REST A + BR EPLUS2 + +EUMIN: TSTB FLTF + BEQ EUMIN1 + NEGD FLT1 + BR EPLUS2 + +EUMIN1: NEG B + BR EPLUS2 + +ELPAR: TSTB POPF + BNE ARPAD ;FINISHING OFF OP STACK. LIKE ANOTHER R PAREN + TSTB EVINLF + BEQ ELPAR9 + TST (F) ;ARE WE AT THE BOTTOM OF THE OP STACK? + BEQ EVLSD1 ;READ (XXX) FOR INSTRUCTION TYPEIN +ELPAR9: TSTB EVSIZE + BEQ ELPAB + LDD FLT1,AC0 + STD AC0,-(E) + JMP EVALLP + +ELPAB: MOV B,-(E) + JMP EVALLP + +ECOMMA: MOVB B,TVAL+1 + MOV TVAL,B + SWAB B + BR EPLUS2 + ;ALPAR, ARPAR, EVPOP, EVALPP, ANOVAL + +EVALPP: TSTB POPF + BEQ ALPERR ;ERROR IF NOT INTENTIONAL + TSTB EVREGF + BNE EVLPP1 ;BRANCH IF REGISTER VALUE +EVLPP2: TSTB EVSIZE+1 + BEQ EVLPP3 ;NO NEW VALUE, COPY LAST TO CURRENT + MOVB EVREGF,LVREGF ;SAVE REGISTER FLAG + MOVB EVSIZE,LVFLTF ;AND FLOATING VALUE FLAG + MOV B,LVAL ;AND INTEGER VALUE + LDD FLT1,AC0 + STD AC0,LFVAL ;AND FLOATING VALUE + RTS PC ;RETURN TO WHOEVER CALLED EVPOP + +EVLPP3: MOVB LVREGF,EVREGF + MOVB LVFLTF,EVSIZE + MOV LVAL,B + LDD LFVAL,AC0 + STD AC0,FLT1 +EVPOPX: RTS PC + +EVLPP1: TST B + BMI ALPERR ;NEGATIVE REGISTER VALUE LOSES + CMP B,#/2 ;IS THIS VALUE IN DDT'S VARIABLE PAGE + BLO EVLPP2 ;REGISTER VALUE OK +ALPERR: JMP QERR + +ALPAB: TSTB EVINSF + BEQ ALPERR + JSR PC,EVPOP ;GOT VAL( WHILE READING INSTRUCTION. GET VAL AND RET + MOV #'(,A + RTS PC + +ALPAR: TSTB EXSYMF + BNE ALPAB ;NOT EXPECTING VALUE AT THIS TIME + TSTB EXNUMF + BNE ALPAB ;DON'T WANT VALUE + TSTB EVNOVF + BNE ALPAB + MOV #1001,-(F) ;PUSH OPERATOR 1 PRECEDENCE 1 ON THE OP STACK + JMP EVALLP + +EVPOP1: TSTB EXNUMF + BEQ EVALPP ;NO VALUES ANYWHERE, RETURN + INCB EVSIZE+1 + TSTB FLTF + BEQ EVPOP3 + INCB EVSIZE + BR EVPOP3 + +EVPOP: TSTB POPF + BNE EVPOPX ;WE'VE BEEN HERE BEFORE + INCB POPF +ARPAR: JSR PC,EVSYM ;EVALUATE SYMBOL IF IT EXISTS + TSTB EVSIZE+1 + BEQ EVPOP1 ;DON'T HAVE ANY VALUE YET + TSTB EXNUMF + BEQ ARPAB ;THERE IS NO VALUE, USE TOP TWO ON THE STACK +EVPOP3: TSTB EVNOVF ;SEE IF NO VALUE EXPECTED + BNE ALPERR ;YES +ARPAD: INCB EVNOVF ;SAY EXPECTING NO VALUE + CLR D ;RIGHT PAREN IS PRECEDENCE 0 + JMP EVALEV ;DO EVALUATION NOW, DOWN TO MATCHING LEFT PAREN + +ARPAB: TSTB EVNOVF ;THERE IS NO VALUE, SEE IF EXPECTING NO VALUE + BEQ ARPAE ;NO VALUE WAS UNEXPECTED. USE ZERO OR ONE AS APPROP + TSTB EVSIZE ;NO VALUE WAS EXPECTED. USE TOP OF VAL STACK + BEQ ARPAC ;INTEGER + LDD (E)+,AC0 + STD AC0,FLT1 + INCB FLTF ;USE TOP OF VAL STACK AS FLOATING POINT VALUE + BR ARPAD + +ARPAC: MOV (E)+,B + BR ARPAD + +ARPAE: CMPB (F),#2 ;INVENT A VALUE. SEE WHAT THE OPERATOR IS + BEQ ARPAF ;+ OR - + CMPB (F),#3 + BEQ ARPAR6 ;MULT OR DIVIDE + CMPB 1(F),#7*2 + BEQ ARPAF ;,, + CMPB (F),#4 + BR ALPERR +ARPAF: CLR B ;UNARY MINUS OR + OR - + CLRD FLT1 ;INVENT SOME ZEROS +ARPAR7: MOVB EVSIZE,FLTF ;SET FLTF IF DOING FLOATING POINT CALCULATION + BR ARPAD + +ARPAR6: MOV #1,B ;INVENT SOME ONES + LDD D1,AC0 + STD AC0,FLT1 + BR ARPAR7 ;AND SET FLTF IF WE'RE DOING FLOATING CALCULATION + +ANOVAL: TSTB EXNUMF + BEQ ANOVA1 ;THERE WAS NO VALUE + TSTB EVNOVF + BNE ALPERR ;WAS VALUE AND EXPECTING NO VALUE. LOSE +ANOVAX: RTS PC + +ANOVA1: TSTB EVNOVF + BEQ ANOVAX ;WAS NO VALUE AND NOT EXPECTING NO VALUE + INCB EXNUMF ;USE TOP OF STACK AS VALUE. I.E. WE HAVE A VALUE NOW + CLRB EVNOVF + TSTB EVSIZE + BEQ ANOVA2 ;INTEGER + LDD (E)+,AC0 ;POP TOP OF VALUE STACK + STD AC0,FLT1 ;AND USE AS FLOATING POINT VALUE + INCB FLTF ;INDICATE FLOATING POINT VALUE + RTS PC + +ANOVA2: MOV (E)+,B ;POP TOP OF VALUE STACK AND USE AS INTEGER VALUE + RTS PC + +.SBTTL EXPRESSION READER + +;TRY TO READ AN EXPRESSION +EXPR: CLRB FLTF + CLR EXSYMF ;CLEARS EXNUMF TOO + CLRB NUMOM ;CLEAR NUMBERS ONLY MODE + CLR POWER + JSR PC,GETTOK ;GET NEXT TOKEN + BR EXPB +EXPRQE: JMP QERR ;NUMBER FOLLOWED BY LETTER. SAY ? +EXPB: MOV SYMF,EXSYMF ;COPIES NUMF TOO + TSTB NUMF + BEQ EXPRX ;NOT A NUMBER + CMP A,#'. + BNE EXPRX ;NUMBER IN B, WORK ON EXPRESSION + STD AC0,FLT1 ;SAVE ACCUMULATED DECIMAL + INCB NUMOM ;SET NUMBERS ONLY MODE + JSR PC,GETTOK ;NUMBER FOLLOWED BY . GET SOME MORE + TSTB NUMF + BNE EXPRFL ;NUMBER, . , NUMBER +EXPRL2: CMPB A,#'E + BEQ EXPRF1 + MOVB A,SNEAK1 ;PUT CHARACTER BACK FOR GETTOK TO READ + INCB FLUSHF ;SET FLUSHF FOR GETTOK (GETKS) + JSR PC,GETKS ;MAKE PECIAL ENTRY INTO GETTOK + TSTB SYMF + BNE EXPRQE ;DECIMAL OR FLOATING THEN SYM (NOT E) GIVE ? + TSTB FLTF ;MUST HAVE BEEN LONE SEPARATOR TO GET HERE + BNE EXPRFX ;DO POWER STUFF IF FLOATING + LDD FLT1,AC0 ;GET DECIMAL BACK + STCDI AC0,B ;INTO B +EXPRX: RTS PC + +EXPRFL: INCB FLTF + MOVB DIGITS,POWER ;SAVE NUMBER OF PLACES AFTER DECIMAL POINT + MOVB DIGITS,D + LDD FLT1,AC1 + ASH #3,D + MULD DTENTB(D),AC1 + ADDD AC1,AC0 + STD AC0,FLT1 ;FLT1 GETS NEW COMBINED VALUE + BR EXPRL2 + +;HAVE DOUBLE PRECISION FLOATING NUMBER IN FLT1, WITH POWER SET UP +;SUCH THAT THE REAL VALUE IS FLT1*10^-POWER. WE HAVE JUST SEEN AN +;E FOLLOWING THE NUMBER, BUT WE DON'T KNOW WHAT'S AFTER THE E +EXPRF1: INCB FLTF + CLRB NEGEXF + JSR PC,TYI ;GET NEXT CHAR + CMP A,#'+ + BEQ EXPRF2 + CMP A,#'- + BEQ EXPRF3 +EXPRF0: CMP A,#'0 + BLT EXPRFZ ;NOT +, - OR NUMBER + CMP A,#'9 + BGT EXPRFZ ;NOT +, - OR NUMBER + MOVB A,SNEAK1 ;PUT THE NUMBER BACK + INCB NUMOM ;AND READ THE NUMBER WITH GETTOK + JSR PC,GETTOK ;IN NUMBERS ONLY MODE + TSTB NUMF + BEQ EXPRFZ ;NO EXPONENT GIVEN + STCDI AC0,B ;GET DECIMAL OF POWER + LDD FLT1,AC0 + TSTB NEGEXF + BEQ EXPRF5 + NEG B +EXPRF5: SUB POWER,B ;VALUE IS FLT1*10^B + CMP B,#-38. + BGE EXPRX1 ;POWER IS -38 + ADD #38.,B ;MULTIPLY BY WHAT'S LEFT LATER + MULD DM38,AC0 ;MULTIPLY BY 10^-38 NOW +EXPRX1: ASH #3,B + MULD DTENTB(B),AC0 + STD AC0,FLT1 + RTS PC + +EXPRF3: INCB NEGEXF ;SET NEGATE EXPONENT FLAG +EXPRF2: JSR PC,TYI + BR EXPRF0 + +EXPRFZ: MOVB A,SNEAK1 + INCB FLUSHF + JSR PC,GETKS ;FLUSH UNTIL A SEPARATOR + JMP QERR ;GIVE ? + +EXPRFX: CLR B + BR EXPRF5 + +.SBTTL TOKEN READER + +;GET A TOKEN (SYMBOL, NUMBER, SEPARATOR) +;GIVE ? ERROR MESSAGE IF SKIP RETURNS +GETTOK: CLR B ;ACCUMULATE OCTAL IN B + CLRD AC0 ;ACCUMULATE DECIMAL IN AC0 + CLRB NUMF + CLRB DIGITS + CLRB FLUSHF +GETKS: CLRB SYMF + CLR SYM + CLR SYM1 ;ACCUMULATE RADIX50 SYMBOL + MOV #SYM,C ;POINTER FOR STORING RADIX 50 +GETOKM: MOV #3,E ;COUNT FOR SYM +GETNTK: JSR PC,TYI ;GET NEXT CHARACTER IN A + MOV A,F + JSR PC,GETR + BR GETKX1 ;SEPARATOR + TSTB SYMF + BNE GETOKT ;NEXT CHAR FOR SYMBOL + TSTB FLUSHF + BNE GETOKT ;GOBBLE CHARACTERS UNTIL A SEPARATOR + CMP A,#'0 + BLT GETOK2 ;NOT NUMBER + CMP A,#'9 + BGT GETOK2 ;NOT NUMBER + INCB NUMF ;HAVE SEEN A NUMBER + INCB DIGITS ;COUNT OF DIGITS (NOT SAME AS NUMF!!) + SUB #'0,A + ASH #3,B + ADD A,B ;ACCUMULATE OCTAL + MULD D10,AC0 + LDCID A,AC1 ;CONVERT A TO DOUBLE PRECISION FLOATING + ADDD AC1,AC0 ;ACCUMULATE DECIMAL + BR GETNTK + +;NON-NUMERIC AND HAVEN'T SEEN NON-NUMERIC BEFORE +GETOK2: TSTB NUMOM + BNE GETOKX ;NUMBERS ONLY MODE AND NON-NUMERIC - EXIT + CMP A,#'. + BEQ GETOKP + TSTB NUMF + BEQ GETOKT + ADD #2,(P) ;NO. SKIP RETURN - GIVE ? ERROR + INCB FLUSHF + CLRB NUMF +GETOKT: INCB SYMF ;HAVE SEEN SYMBOL CONSTITUENT + MOV @C,B + MUL #50,B + ADD F,B + MOV B,@C + SOB E,GETNTK ;DEC COUNT OF REMAINING RADIX50 SLOTS THIS WORD + TST (C)+ ;SYM FILLED UP, MOVE ON TO SYM1 + CMP C,#SYM2 + BLE GETOKM ;RESET COUNT IN E AND GET NEXT CHAR + TST -(C) ;ASSEMBLE OVERFLOW CRUD IN SYM2 + BR GETOKM + +GETKX1: TSTB SYMF + BEQ GETOKX + MOV @C,F +GETKX2: MUL #50,F ;LEFT ADJUST THE RADIX 50 SYMBOL + SOB E,GETKX2 + MOV F,@C +GETOKX: CLRB NUMOM + CLRB FLUSHF + RTS PC + +;GOT INITIAL . MAYBE +GETOKP: TSTB NUMF + BNE GETOKX ;. AFTER NUMBER - EXIT + JSR PC,STYI ;INITIAL . GET NEXT TO FIGURE OUT WHAT TO DO + CMP A,#'0 + BLT GETKP1 ;NOT NUMBER, TREAT . AS SYMBOL CONSTITUENT + CMP A,#'9 + BGT GETKP1 ;NOT NUMBER, TREAT . AS SYMBOL CONSTITUENT + INCB NUMF ;. THEN NUMBER, TREAT AS 0. + MOV #'.,A ;PUT BACK . + BR GETOKX ;EXIT + +GETKP1: MOV #34,F ;RADIX 50 FOR . + BR GETOKT ;TREAT . AS PART OF SYMBOL + ;GETR CONVERT ASCII CHAR IN F TO RADIX 50 AND SKIP UNLESS NOT RADIX 50 CHAR + +GETR: CMPB F,#'. + BEQ GETRP + CMPB F,#'% + BEQ GETRC + CMPB F,#'$ + BEQ GETRD + CMPB F,#'0 + BLT GETRX + CMPB F,#'9 + BLE GETRN + CMPB F,#'A + BLT GETRX + CMPB F,#'Z + BGT GETRX + SUB #'A-1,F +GETROX: ADD #2,(P) +GETRX: RTS PC + +GETRN: SUB #'0-36,F + BR GETROX + +GETRP: MOV #34,F + BR GETROX + +GETRC: MOV #35,F + BR GETROX + +GETRD: MOV #33,F + BR GETROX + +.SBTTL INSTRUCTION TYPIN + +INSTIN: MOV #OPCTB,C ;START OF OPCODE TABLE +INSTI1: TST (C) + BNE INSTI2 ;NOT CHANGING BLOCKS NOW + TST (C)+ ;SKIP OVER INITIAL ZERO + MOV (C)+,D ;SAVE TYPIN ADDRESS, SKIP TO TYPEOUT ADDRESS + BEQ INSTNF ;IF TYPIN IS ZERO THE LIST IS DONE + CMP (C)+,(C)+ ;SKIP TYPEOUT ADDRESS AND MASK +INSTI2: CMP SYM,(C) + BNE INSTI3 + CMP SYM1,2(C) + BEQ INSTIF ;MATCH +INSTI3: ADD #6,C + BR INSTI1 + +INSTNF: RTS PC ;NOT AN INSTRUCTION + +INSTIF: TSTB EVINSF + BNE INSTIE ;ERROR IF INSTRUCTION ALREADY STARTED + MOV #PDL-2,P ;DON'T RETURN TO EVAL + INCB EVSIZE+1 ;IN CASE OF SINGLE SYMBOL INSTRUCTIONS + INCB EVINSF + CLR INREL + MOV #INREL,INRELP + MOVB #1,EVINSC ;START OFF INSTRUCTION COUNT AT 1 WORD + MOV 4(C),INS1 ;SAVE INSTRUCTION VALUE + MOV #INS2,INP + JMP (D) ;GO TO TYPIN ADDRESS + +INSTIE: JMP QERR + +;READ SOURCE OR DESTINATION FIELD. RETURN 6 BITS OF ADDRESS MODE AND REGISTER +;IN C, STORES VALUE IF ANY IN @INP AND UPDATES INREL AND INP AND INRELP +;AND EVINSC, RETURNS SEPARATOR IN A +GETSD: CLRB INSSDD +GETSD1: JSR PC,TYI + CMP A,#40 + BEQ GETSD1 + CMP A,#11 + BEQ GETSD1 + CMP A,#'@ + BEQ GTSDAT +GETSD2: CMP A,#'# + BEQ GTSDNB + CMP A,#'- + BEQ GTSDMI + CMP A,#'( + BEQ GTSDLP + MOVB A,SNEAK1 ;PUT CHARACTER BACK WHERE TYI CAN READ IT +GETSD4: JSR PC,EVALI ;GET NEXT VALUE + CMP A,#'( + BEQ GTSDID ;VALUE FOLLWED BY REG IN PARENS + TSTB EVREGF + BNE GETSDR + BISB #67,INSSDD ;INDEX BY PC + SUB INP,B ;SUBTRACT APPROPRIATE PC FROM VALUE + ADD #INS2-4,B + MOV B,@INP + INCB @INRELP ;INDICATE @INP NEEDS TO BE RELOCATED +GETSD3: ADD #2,INP + INCB EVINSC + INC INRELP +GETSDX: MOVB INSSDD,C ;SIGN BIT WON'T EVER BE ON IN INSSDD BYTE + RTS PC + +GETSDR: BISB B,INSSDD ;PUT REGISTER NUMBER IN INSSDD + BR GETSDX ;RETURN WITHOUT ADVANCING POINTERS (DIDN'T USE MEM) + +GTSDAT: BIS #10,INSSDD ;INDICATE DEFERRED MODE + BR GETSD1 + +GTSDNB: BISB #27,INSSDD + JSR PC,EVALI + TSTB EVREGF + BNE GETERR ;#%X LOSES + MOV B,@INP + BR GETSD3 ;BUMP BOTH INP AND INRELP AND RETURN + +GTSDMI: JSR PC,TYI + CMP A,#'( + BNE GTSDM1 + MOVB A,SNEAK1 ;PUT BACK LEFT PAREN + BISB #40,INSSDD ;INDICATE AUTO DEC + JSR PC,EVALI ;GET REGISTER NUMBER IN PARENS + TSTB EVREGF + BEQ GETERR ;DIDN'T GET A REGISTER VALUE + BR GETSDR + +GTSDM1: MOVB A,SNEAK2 ;PUT BACK LEFT PAREN + MOVB #'-,SNEAK1 ;AND MINUS AND READ IT ALL AS AN EXPRESSION + BR GETSD4 + +GTSDLS: MOVB A,SNEAK1 ;PUT BACK LEFT PAREN + INCB EVINLF ;CAUSE EVALI TO RETURN AFTER CLOSED PAREN + JSR PC,EVALI ;READ EXPRESSION IN PARENS + CLRB EVINLF ;CLEAR THE FLAG FOR FURTHER CALLS ON EVALI + TSTB EVREGF + BEQ GETERR ;HE TRIED TO FOOL US WITH (NOTREG) + JMP TYI ;GOT (REG) + +GTSDLP: JSR PC,GTSDLS + CMP A,#'+ + BNE GTSDL2 + JSR PC,TYI + BISB #20,B ;AUTO INCREMENT +GTSDL3: BISB B,INSSDD + BR GETSDX + +GTSDL2: BISB #10,B + MOV B,C + RTS PC + +GTSDID: MOV B,@INP ;STORE INDEX + ADD #2,INP + INCB EVINSC + INC INRELP ;UNRELOCATED + JSR PC,GTSDLS ;READ WHAT'S IN PARENS + BIS #60,B + BR GTSDL3 + +CGTRIN: JSR PC,GETRIN +CGTRI1: CMP A,#', + BNE GETERR + RTS PC + +CGTFAI: JSR PC,GETFAI + BR CGTRI1 + +GETRIN: JSR PC,GETREG +GETRI1: ASH #6,C + BIS C,INS1 + RTS PC + +GETFAI: JSR PC,GETREG + CMP C,#4 + BGE GETERR + BR GETRI1 + +GETREG: JSR PC,GETSD + CMP C,#7 + BGT GETERR ;MUST BE A REGISTER + RTS PC + +CGETSD: JSR PC,GETSD + CMP A,#', + BNE GETERR + RTS PC + +GETADD: JSR PC,GETSD + CMP C,#67 + BNE GETERR + DECB EVINSC + CLR INREL + ADD #4,INS2 ;UNRELOCATE + RTS PC + +GETERR: JMP QERR + +.SBTTL INSTRUCTION TYPEOUT + +;TYPE OUT VALUE AS AN INSTRUCTION +;VALUE IS IN B AND INSVAL AND THE ADDRESS IS IN INSLOC +INSTTY: MOV #OPCTB,C ;START OF OPCODE TABLE +INSRCH: TST (C) + BNE INSRC1 ;NOT CHANGING BLOCKS NOW + CMP (C)+,(C)+ ;SKIP OVER 0 AND TYPIN ADDRESS + BEQ INSRNF ;IF TYPIN IS ZERO THE LIST IS DONE + MOV (C)+,F ;SAVE TYPEOUT ADDRESS + MOV (C)+,E ;LOAD UP THE NEW BIC MASK +INSRC1: MOV B,D ;COPY OF VALUE + BIC E,D ;MASKED + CMP D,4(C) ;COMPARE VALUES + BEQ INSRCF ;MATCH + ADD #6,C + BR INSRCH + +INSRNF: JMP ASLAS2 ;CAN'T TYPE AS INSTRUCTION, TYPE AS SIGNED NUMBER + +INSRCF: CMP D,#170000 + BHIS INSRFF ;FLOATING POINT INSTRUCTION + CMP D,#104000 ;IS IT AN EMT? + BNE INSRCE ;NO + JSR PC,SCTYPE ;TRY TO TYPE IT AS SYSTEM CALL + BEQ INSRCE ;TYPE NORMALLY IF WE FAIL + MOV #2,SSDDPC ;NUMBER OF BYTES TAKEN BY EMT + RTS PC +INSRCE: JSR PC,INNMTY ;TYPE INSTRUCTION NAME +INSRCG: MOV INSLOC,SSDDPC + ADD #2,SSDDPC + JSR PC,(F) + SUB INSLOC,SSDDPC ;NUMBER OF BYTES TAKEN BY INSTRUCTION + RTS PC + +INSRFF: TSTB FLTIMD + BNE INSRCG ;TYPE FLOATING POINT INSTRUCTIONS + BR INSRNF ;TYPE AS SIGNED NUMBER + +;TYPE OUT INSTRUCTION NAME FOLLOWED BY A SPACE +INNMTY: MOV C,SYTYAD + JSR PC,SYMOUT ;TYPE THE INSTRUCTION NAME + MOV #40,A + JMP TYO + ;SSORDD + +;SSDDPC HAS ADDRESS OF WORD AFTER LAST WORD LOOKED AT, INITIALLY +;POINTS AT WORD AFTER ADDRESS OF INSTRUCTION +;F HAS SIX BITS OF SOURCE OR DESTINATION +SSORDD: CLR E + BIC #177700,F + DIV #10,E ;E_MODE, F_REGISTER + CMP F,#7 + BEQ PCREG ;PC ADDRESSING +NPCREG: MOVB LSTADG,PLSADG + MOV LSTADR,PLSTAD + INCB LSTADG + MOV F,LSTADR + TST E + BEQ REGMD ;REGISTER MODE + CMP E,#2 + BLT REGDMD ;REGISTER DEFERRED MODE + BEQ AINCMD ;AUTOINCREMENT MODE + CMP E,#4 + BLT AINDMD ;AUTOINCREMENT DEFERRED MODE + BEQ ADECMD ;AUTODECREMENT MODE + CMP E,#6 + BLT ADEDMD ;AUTODECREMENT DEFERRED MODE + BGT INDDMD ;INDEX DEFERRED MODE +INDXMD: MOV SSDDPC,A + ADD #2,SSDDPC + JSR PC,GETWRD ;GET INDEX IN B + MOV F,-(P) ;SAVE REGISTER NUMBER + JSR PC,SYTYPE ;TRY TO TYPE AS A SYMBOL + MOV (P)+,B ;GET REGISTER NUMBER BACK +PARREG: MOV #'(,A + JSR PC,TYO + JSR PC,RSYTYP ;TYPE REGISTER AS SYMBOL IF POSSIBLE + MOV #'),A + JMP TYO + +INDDMD: MOV #'@,A + JSR PC,TYO + BR INDXMD + +REGDMD: MOV F,B + BR PARREG + +REGMD: MOV F,B + JMP RSYTYP + +AINDMD: MOV #'@,A + JSR PC,TYO +AINCMD: MOV F,B + JSR PC,PARREG + MOV #'+,A + JMP TYO + +ADEDMD: MOV #'@,A + JSR PC,TYO +ADECMD: MOV #'-,A + JSR PC,TYO + MOV F,B + BR PARREG + +PCREG: CMP E,#1 + BLE NPCREG + CMP E,#3 + BLT IMMED + BEQ ABSOL + CMP E,#5 + BLE NPCREG + CMP E,#7 + BLT RELAT + MOV #'@,A ;RELATIVE DEFERRED MODE + JSR PC,TYO +RELAT: MOV SSDDPC,A + JSR PC,GETWRD ;GET THE INDEX IN B + ADD #2,A ;BUMP ADDRESS BY 2 + MOV A,SSDDPC + ADD A,B ;THIS IS THE ACTUAL ADDRESS +RELAT2: MOV LSTADR,PLSTAD + MOVB LSTADG,PLSADG + MOV B,LSTADR + CLRB LSTADG +RELAT1: JMP SYTYPE ;TRY TO TYPE AS A SYMBOL + +ABSOL: MOV #'@,A + JSR PC,TYO +IMMED: MOV #'#,A + JSR PC,TYO + MOV SSDDPC,A + JSR PC,GETWRD + ADD #2,SSDDPC + CMP E,#3 + BNE RELAT1 ;NOT ABSOLUTE MODE + BR RELAT2 ;ABSOLUTE ADDRESS + DOPOUT: MOV INSVAL,F + ASH #-6,F ;LINE UP SS IN BOTTOM SIX BITS + JSR PC,SSORDD + MOV #',,A + JSR PC,TYO + +;VALUE IN INSVAL, ADDRESS IN INSLOC +SOPOUT: MOV INSVAL,F + JMP SSORDD + +BROUT: MOVB INSVAL,B ;OFFSET (SIGN EXTENDED) +BROUT1: ASL B ;OFFSET*2 + ADD INSLOC,B + ADD #2,B ;PC+OFFSET*2 + MOV LSTADR,PLSTAD + MOVB LSTADG,PLSADG + MOV B,LSTADR + CLRB LSTADG + JMP SYTYPE + +RROUT: MOV INSVAL,B + ASH #-6,B ;GET REGISTER NUMBER IN B + BIC #177770,B + JMP RSYTYP + +RDOUT: JSR PC,RROUT + MOV #',,A + JSR PC,TYO + BR SOPOUT ;DO A DD + +RSOUT: JSR PC,SOPOUT ;ALMOST THE SAME AS A SINGLE OP INSTRUCTION + MOV #',,A + JSR PC,TYO + JMP RROUT + +SOBOUT: JSR PC,RROUT ;TYPE OUT REGISTER + MOV #',,A + JSR PC,TYO + MOV INSVAL,B + BIC #177700,B ;SIX BIT WORD OFFSET + NEG B + BR BROUT1 + +MS2OUT: MOV INSVAL,B + BIC #177400,B + JMP OTYPE ;TYPE UNSIGNED LOW BYTE + +RTSOUT: MOV INSVAL,B + BIC #177770,B ;GET REGISTER + JMP RSYTYP + +PLOUT: MOV INSVAL,B + BIC #177770,B ;GET PRIORITY LEVEL + JMP OTYPE ;AND TYPE IN OCTAL + +MRKOUT: MOV INSVAL,B + BIC #177700,B + JMP OTYPE + +CCOUT: MOV INSVAL,B + ASR B + BCC CCOUT1 + MOV #'C,A + JSR PC,TYO +CCOUT1: ASR B + BCC CCOUT2 + MOV #'V,A + JSR PC,TYO +CCOUT2: ASR B + BCC CCOUT3 + MOV #'Z,A + JSR PC,TYO +CCOUT3: ASR B + BCC INRET + MOV #'N,A + JMP TYO + +INRET: RTS PC + +FMOUT: JMP INNMTY ;TYPE INSTRUCTION NAME + +FSOOUT: CMP INSVAL,#170400 + BLO FSOOU1 ;LDFPS, STFPS OR STST + TSTB UFPST ;BIT 7 IS FLOATING DOUBLE MODE + BPL FSOOU1 ;USER IS IN FLOATING MODE, TYPE F VERSION + ADD #6,C ;MOVE TO D VERSION OF INSTRUCTION +FSOOU1: JSR PC,INNMTY +FSOOU2: MOV INSVAL,F + JMP SSORDD + +FSAOUT: TSTB UFPST + BPL FSAOU1 ;USER IS IN FLOATING MODE, TYPE F VERSION + ADD #6,C +FSAOU1: JSR PC,INNMTY + MOV INSVAL,F + JSR PC,SSORDD + MOV #',,A + JSR PC,TYO + MOV INSVAL,B + ASH #-6,B + BIC #177774,B ;2 BIT AC NUMBER + JMP RSYTYP + +SRAOUT: CMP INSVAL,#177000 + BLO FSAOU1 ;TYPE LDEXP DIRECTLY + TSTB UFPST + BPL SRAOU2 ;FLOATING + ADD #6,C ;DOUBLE +SRAOU2: BIT #100,UFPST + BEQ FSAOU1 ;INTEGER + ADD #14,C ;LONG + BR FSAOU1 + +AFDOUT: TSTB UFPST + BPL AFDOU1 + ADD #6,C +AFDOU1: JSR PC,INNMTY + MOV INSVAL,B + ASH #-6,B + BIC #177774,B + JSR PC,RSYTYP + MOV #',,A + JSR PC,TYO + BR FSOOU2 + +ADSOUT: CMP INSVAL,#175400 + BLO AFDOU1 + TSTB UFPST + BPL ADSOU1 + ADD #6,C +ADSOU1: BIT #100,UFPST + BEQ AFDOU1 + ADD #14,C + BR AFDOU1 + +DOPIN: JSR PC,CGETSD ;READ SS OR DD + ASH #6,C + BIS C,INS1 +SOPIN: JSR PC,GETSD ;READ SS OR DD +SOPEX1: BIS C,INS1 ;STORE DD IN INSTRUCTION +SOPEX: CLRB LVREGF + CLRB LVFLTF + MOV INS1,B + MOV B,LVAL + CMP A,#40 + BEQ SOPEX2 + TSTB INLTB(A) + BLE OPINER ;NOT AN INSTRUCTION SEPARATOR + JMP EVALNI ;DIPATCH ON A THROUGH CMDTB + +SOPEX2: JSR PC,TYI + BR SOPEX + +SOBIN: JSR PC,CGTRIN ;GET R +BRIN: JSR PC,GETADD + DECB INREL ;INDICATE PECIAL BRANCH RELOCATION + BR SOPEX + +RDIN: JSR PC,CGTRIN ;GET R + BR SOPIN ;GET DD + +RSIN: JSR PC,CGETSD ;GET SS + BIS C,INS1 + JSR PC,GETRIN ;GET R + BR SOPEX + +MSCIN: INCB POPF ;SO THAT FUTURE CALLS ON EVPOP WILL BE NOPS + BR SOPEX + +MS2IN: JSR PC,GETADD ;GET NUMBER +MS2IN2: BISB INS2,INS1 ;SET IN THE BOTTOM BYTE + CLR INS2 + SUB #2,INP ;BECAUSE IT IS INCREMENTED BY GETADD + BR SOPEX + +RTSIN: JSR PC,GETREG ;GET R + BR SOPEX1 + +PLIN: JSR PC,GETADD ;GET PRIORITY LEVEL + BIC #177770,INS2 + BR MS2IN2 + +MRKIN: JSR PC,GETADD ;GET NN + BIC #177700,INS2 + BR MS2IN2 + +OPINER: JMP QERR + ;CCIN, FSAIN, AFDIN + +CCIN: JSR PC,TYI + MOV #3,B +CCIN2: CMPB A,CCINTB(B) + BEQ CCIN1 + DEC B + BGE CCIN2 + INCB POPF ;SO THAT FUTURE CALLS ON EVPOP WILL BE NOPS + BR SOPEX + +CCIN1: MOV #1,A + ASH B,A + BIS A,INS1 + BR CCIN + +FSAIN: JSR PC,CGETSD ;GET SS, + BIS C,INS1 + JSR PC,GETFAI + BR SOPEX + +AFDIN: JSR PC,CGTFAI ;GET AC, + BR SOPIN + + +.SBTTL MISCELLANEOUS COMMANDS +NOVCHK: TSTB EXSYMF + BNE NOVERR + TSTB EXNUMF + BNE NOVERR + TSTB EVNOVF + BNE NOVERR + RTS PC + +NOVERR: JMP QERR + +;AEQUL DOESN'T CHECK FOR A VALUE HAVING BEEN GIVEN SINCE IF ONE ISN'T GIVEN +;EVAL SETS UP EVREGF, B, EVSIZE AND FLT1 FROM THE LAST VALUE +AEQUL: JSR PC,TRESET ;CLEAR ANY CHARS IN THE BUFFER + TSTB EVREGF + BEQ AEQUL1 ;NOT REGISTER VALUE + JMP RGTYPE ;TYPE REGISTER VALUES AS SYMBOLS +AEQUL1: TSTB EVSIZE + BNE AEQUL2 ;FLOATING VALUE + TSTB EVSIZE+1 ;SYMBOL TYPED? + BNE 1$ + BIC #177776,LFINC + BNE 1$ + MOV #2,LFINC +1$: JMP NTYPE ;TYPE NUMBER IN B + +AEQUL2: LDD FLT1,AC0 + JMP FTYPE + +ASQUO: JSR PC,NOVCHK ;COMPLAIN IF THERE IS A VALUE + JSR PC,TYI + MOV A,B ;USE ASCII AS VALUE +ASQUO1: JSR PC,GETNXS ;READ UNTIL NEXT SEPARATOR +ASQUO2: INCB EXNUMF + TSTB EVINSF + BNE ASQUO3 ;READING INSTRUCTION + JMP EVALCE +ASQUO3: TSTB INLTB(A) + BGT ASQUOX ;INSTRUCTION SEPARATOR + BMI NOVERR ;ILLEGAL IN INSTRUCTION + JMP EVALCE ;ARITH OP, KEEP GOING IN EVAL + +ADQUO: JSR PC,NOVCHK + JSR PC,TYI + MOV A,B ;SAVE LOW BYTE VALUE + JSR PC,TYI + SWAB A + BIS A,B + BR ASQUO1 + +GETNXS: MOV E,-(P) + MOV F,-(P) + INCB FLUSHF + JSR PC,GETKS + MOV (P)+,F + MOV (P)+,E +ASQUOX: RTS PC + +AAMPR: JSR PC,NOVCHK + MOV #3,C + CLR B + MOV F,-(P) +AAMPB: JSR PC,TYI + MOV A,F + JSR PC,GETR ;TRY TO CONVERT TO RADIX 50 + BR AAMPC ;NOT RADIX 50 + MUL #50,B + ADD F,B + SOB C,AAMPB + MOV (P)+,F + BR ASQUO1 + +AAMPC: MUL #50,B + SOB C,AAMPC + MOV (P)+,F + BR ASQUO2 + +;ACOLN'S ENTRY IN POPTB IS ZERO SO THAT SYMBOLS WON'T BE LOOKED UP +;THEREFORE, ACOLN MUST CHECK THE SYMBOL FLAG ITSELF +ACOLN: TSTB EXSYMF + BEQ ACOLNC ;EXECUTE A COLON COMMAND + TSTB EVSIZE+1 + BNE ACOLNR + JSR PC,SYMLK ;SEE IF SYMBOL ALREADY EXISTS + BR ACOLN1 ;NO, ADD IT AT THE END + CMP (B)+,(B)+ ;YES, JUST CHANGE ITS VALUE + BR ACOLN4 + +ACOLN1: CMP D,#1 + BNE ACOLN2 + CLR 6(B) ;INVENTING NEW GROUP OF 16, CLEAR HKILL + CLR 10(B) ;AND REGISTER FLAG WORDS +ACOLN2: MOV B,SYMEND + MOV SYM,(B)+ + MOV SYM1,(B)+ +ACOLN4: TST VALP + BEQ ACLN4A + MOV VAL1,(B) ;STORE NEW VALUE GIVEN + MOV VALRF,A + BIC #177775,A ;KEEP REGISTER FLAG BIT FOR VAL1 + BR ACLN4B + +ACLN4A: MOV DOTVAL,(B) ;STORE NEW VALUE FROM . + MOV DOTRGW,A + BIC #177776,A ;KEEP REGISTER FLAG BIT FOR . +ACLN4B: MOV REGWAD,C ;ADDRESS OF REGISTER WORD + BIC D,@C ;CLEAR REGISTER FLAG + TST A + BEQ ACOLN3 ;VALUE ISN'T A REGISTER + BIS D,@C ;SET THE REGISTER FLAG +ACOLN3: BIC D,-2(C) ;CLEAR THE HALF KILLED FLAG + RTS PC + +ACOLNC: JMP COLCMD ;EXECUTE COLON COMMAND +ACOLNR: JMP QERR + +;RETURN ONLY IF THERE IS AN INTEGER VALUE +NUMCHK: TSTB EVSIZE+1 + BEQ ACOLNR ;NO VALUE + TSTB EVSIZE + BNE ACOLNR ;FLOATING VALUE + TSTB EVREGF + BNE ACOLNR ;REGISTER VALUE + TSTB EVINSF + BNE ACOLNR ;INSTRUCTION VALUE + RTS PC + +AGREAT: +ALESS: TSTB EVREGF + BNE ALESS2 ;REGISTER IS OK + JSR PC,NUMCHK ;MUST HAVE INTEGER IN B +ALESS2: MOV VALP,C + MOV B,VAL1(C) + ADD #2,C + TSTB EVREGF + BEQ ALESS3 + BIS C,VALRF +ALESS3: CMP C,#4 + BLE ALESS1 + TST -(C) +ALESS1: MOV C,VALP + JMP CMD3 ;RETURN TO MAIN LOOP WITHOUT RESETTING VALP + + + +.SBTTL LOCATION OPENING FUNCTIONS + +ABACK4: INCB OPLORF + ASL A ;CONVERT REGISTER NUMBER TO OFFSET FROM UA + MOVB UA(A),B + BR ABACK5 + +ABACK: CLR E + BR ASLAS0 + +ABACK1: TST E ;IF USER TYPED SLASH ON AN ODD ADDRESS + BEQ ABACK2 +ABACK0: JSR PC,TRESET ;KILL ANY CHARS IN BUFFER + MOV #'\,A ;THEN TYPE A \ TO REMIND HIM THAT HE IS + JSR PC,TYO ;SEEING JUST ONE BYTE +ABACK2: TYPEIT < > + MOV #1,LFINC ;LF WILL INC BY 1 + MOVB #1,OPENWD ;INDICATE BYTE OPEN + MOV DOTVAL,A + MOV A,OPLOC ;CURRENTLY OPEN LOCATION + CLRB OPLORF + BIT #1,DOTRGW ;SEE IF TYPING A REGISTER + BNE ABACK4 ;YES + JSR PC,GETBYT ;GET CONTENTS OF BYTE +ABACK5: MOV B,LVAL + MOV LSTADR,PLSTAD + MOVB LSTADG,PLSADG + MOV B,LSTADR + CLRB LSTADG + CLRB LVREGF + CLRB LVFLTF + TSTB TXTMD ;ARE WE TYPING TEXT? + BNE ALBRKT ;YES, TYPE IN TEXT MODE +ALBRKX: JMP NTYPE +ALBRKT: MOV #'',A + JSR PC,TYO ;TYPE A ' + MOV B,A + JMP TYO ;TYPE THE CHAR + +ABCK2: BR ABACK2 + +ASLASE: JMP QERR + +ASLASH: MOV #1,E +ASLAS0: TSTB EVSIZE+1 ;SEE IF A VALUE WAS TYPED + BEQ ASLASA ;NO VALUE TYPED + TSTB EVSIZE + BNE ASLASE ;SORRY, CAN'T OPEN FLOATING POINT LOCATION +ASLSA1: MOV B,DOTVAL ;CHANGE VALUE OF DOT + MOV #1,A + BIC A,DOTRGW ;CLEAR BIT SAYING . IS A REGISTER + TSTB EVREGF + BNE ASLAS3 ;NEW VALUE IS A REGISTER +ASLAS8: CMPB SPACMD,#BMODES ;DON'T MAKE THE ODD TEST FOR CAP AND MAP + BGE ASLAS1 ;YES IT WAS CAP OR MAP + BIT #1,DOTVAL ;SEE IF DOT IS NOW ODD + BNE ABACK1 ;TYPE AS BYTE +ASLAS1: TSTB BYTEMD + BNE ABACK1 + SOB E,ABCK2 ;FORK HERE IF BYTE TYPEOUT +ASLAS9: TYPEIT < > + MOVB #2,OPENWD + MOV DOTVAL,A + MOV A,OPLOC ;CURRENTLY OPEN LOCATION + CLRB OPLORF + BIT #1,DOTRGW + BNE ASLAS4 ;DOT IS A REGISTER + JSR PC,GETWRD +ASLAS5: MOV B,LVAL + CLRB LVREGF + CLRB LVFLTF + CMPB SPACMD,#BMODES ;ARE WE TRYING TO OPEN CAPABILITY OR MAP? + BLT ASLAS6 ;NO + MOV #1,LFINC ;CAPS AND MAP HAVE LFINC OF 1 + BR ASLAS2 ;TRY TO TYPE A SYMBOL +ASLAS6: MOV #2,LFINC +ASLAS7: TSTB BRKFL + BNE ASLAS2 + TSTB FLTYMD + BNE ASLASF ;TYPE AS FLOATING POINT + BIT #1,DOTRGW + BNE ASLAS2 ;DON'T TYPE REGISTER AS AN INSTRUCTION + TSTB INSTMD + BNE ASLASI ;TRY TO TYPE AS AN INSTRUCTION +ASLAS2: MOV LSTADR,PLSTAD + MOVB LSTADG,PLSADG + MOV B,LSTADR + CLRB LSTADG + TSTB BRKFL + BNE ALBRKX ;[ TYPE AS UNSIGNED NUMBER IN CURRENT RADIX + TSTB HALFMD + BNE ASLASL ;TYPE AS BYTE,BYTE + TSTB SYMBMD + BNE ASLASS ;TRY TO TYPE AS A SYMBOL PLUS OFFSET + TSTB TXTMD + BNE ASLTXT ;TYPE AS 2 ASCII CHARS + TSTB TXT5MD + BNE ASL5TX ;TYPE AS RADIX 50 + JMP NTYPE ;TYPE AS UNSIGNED NUMBER + +ASLASS: JMP SYTYPE ;TRY TO TYPE B AS SYMBOL PLUS OFFSET + +ASLAS3: BIS A,DOTRGW ;INDICATE DOT IS A REGISTER + BR ASLAS1 +ASLASA: JSR PC,CRLF + MOV LSTADR,B + MOV E,-(P) + TSTB LSTADG + BNE ASLSAR ;OPEN REGISTER + JSR PC,SYTYPE +ASLSB: MOV (P)+,E + MOV #'/,A + JSR PC,TYO + MOV LSTADR,B + MOVB LSTADG,EVREGF + BR ASLSA1 + +ASLAS4: INCB OPLORF ;OPLOC IS A REGISTER +.IFNZ LSI + TST LSICAP ;LSI? + BNE ASLLSI ;YES +.ENDC + + ASL A ;CONVERT REG NUMBER TO OFFSET FROM UA + MOV UA(A),B + BR ASLAS5 +.IFNZ LSI +ASLLSI: JSR PC,OPNREG ;OPEN THE REGISTER + JSR PC,LSIVAL ;GET THE VALUE + BR ASLAS5 ;ALL FINISHED +.ENDC +ASLSAR: JSR PC,RSYTYP + BR ASLSB + + +ASLTXT: TYPEIT " + MOV B,A + JSR PC,TYO + SWAB B + MOV B,A + JMP TYO + +ASL5TX: TYPEIT & + JMP SYMOU1 + +ASLASL: MOV B,-(P) ;SAVE LOW BYTE + SWAB B + BIC #177400,B + JSR PC,NTYPE ;TYPE THE HIGH BYTE + TYPEIT ^/,,/ + MOVB (P)+,B ;GET BACK THE LOW BYTE + BIC #177400,B + JMP NTYPE + +ASLASI: MOV OPLOC,INSLOC + MOV B,INSVAL + JSR PC,INSTTY + MOV SSDDPC,LFINC + RTS PC + +ASLASF: BIT #1,DOTRGW ;IS THIS A REGISTER + BNE ASLSF2 ;YES, GET WORDS OUT OF DDT VARIABLE PAGE + MOV #4,C ;INCREMENT LF'S BY 4 WORDS + TSTB DBLFMD ;DOUBLE FLOATING MODE? + BNE ASLSF1 ;YES + CLRD FTEMP + MOV #2,C +ASLSF1: MOV C,LFINC + ASL LFINC ;SET UP LINE FEED INCREMENT + MOV #FTEMP,D ;TO ADDRESS + JSR PC,GETBLK ;COPY 2 OR 4 WORDS FROM @OPLOC TO FTEMP + BR ASLSF3 +ASLSF2: MOV #4,C ;COUNT IS 4 WORDS + MOV C,LFINC ;IN THE VARIABLE PAGE,4 MEANS 4 WORDS + ADD #UA,A ;FOR REGISTERS, A WAS RELATIVE + MOV #FTEMP,D + MOV (A)+,(D)+ ;COPY THE VALUE TO FTEMP + SOB C,.-2 +ASLSF3: LDD FTEMP,AC0 + JMP FTYPE + +ATAB: JSR PC,CLOSE ;DEPOSIT VALUE IN OPEN LOCATION IF ANY + JSR PC,CRLF + MOV OPLOC,A + CLRB EVREGF + TSTB OPLORF + BNE ATABRG ;OPEN LOCATION WAS A REGISTER + BIC #1,A + JSR PC,GETWRD +ATAB9: MOV B,-(P) + TSTB EVREGF + BNE ATAB8 + JSR PC,SYTYPE +ATAB7: MOV (P)+,B + MOV #'/,A + JSR PC,TYO + MOV #1,E + JMP ASLSA1 +ATAB8: JSR PC,RSYTYP + BR ATAB7 + +ATABRG: +.IFNZ LSI + TST LSICAP ;LSI CAPABILITY? + BEQ ATABR1 ;NO + JSR PC,OPNREG ;OPEN THE REGISTER + JSR PC,LSIVAL ;GET THE VALUE INTO B + BR ATAB9 ;GO DO IT +.ENDC + +ATABR1: ASL A ;CONVERT REG NUMBER TO OFFSET FROM UAî + MOV UA(A),B + BR ATAB9 + +AUARR: JSR PC,CLOSE ;DEPOSIT VALUE IF ANY + JSR PC,CRLF + BIT #1,DOTRGW + BNE AUARB ;DOT IS A REGISTER + BIC #177776,LFINC + BNE 1$ + MOV #2,LFINC +1$: SUB LFINC,DOTVAL ;BUMP DOTVAL + CLRB EVREGF ;NOT REGISTER +AUARC: JMP ALF2 ;JUST LIKE LINE FEED + +AUARB: DEC DOTVAL + BGE AUARB1 + BIC #177770,DOTVAL ;UP ARROW WRAPS AROUND THRU THE REGISTERS +AUARB1: INCB EVREGF ;REGISTER + JMP ALF2 ;JUST LIKE LINE FEED + +ALBRK: INCB BRKFL + JMP ASLASH + +ALARR: MOV PLSTAD,DOTVAL + MOVB PLSADG,EVREGF + BR AUARC + +AAT: JSR PC,CLOSE ;DEPOSIT VALUE IF ANY +.IFNZ LSI + TST LSICAP ;LSI + BEQ AAT1 ;NO + MOV #7,A ;THE REGISTER TO GET + JSR PC,OPNREG ;OPEN IT (THE PC) + JSR PC,LSIVAL ;GET THE VALUE OF IT + MOV B,UPC ;SET IT UP +AAT1: +.ENDC + MOV UPC,DOTVAL + CLRB EVREGF + BIC #1,DOTRGW ;DOT IS NOT A REGISTER3 + BR AUARC + +.SBTTL LOCATIONS CLOSING FUNCTIONS + +ACR: JSR PC,CLOSE + JSR PC,RSTMD + JMP CMD + +RSTMD: MOV PBYTEM,BYTEMD ;RESET TEMPORARY TYPEOUT MODES + MOV PINSTM,INSTMD + MOV PFLTYM,FLTYMD + MOV PABSMD,ABSMD + MOV PTXT5M,TXT5MD + MOVB PSPCMD,SPACMD ;SPACMD IS WHICH SPACE I OR D TO MAKE A REFERENCE IN + RTS PC + +ALF: JSR PC,CLOSE + JSR PC,CRLF + BIT #1,DOTRGW + BNE ALF1 ;DOT IS A REGISTER, BUMP BY 1 + ADD LFINC,DOTVAL +ALF2: CLRB SYTYRF ;ASSUME NOT REGISTER + BIT #1,DOTRGW + BEQ ALF3 + INCB SYTYRF ;REALLY IS REGISTER +ALF3: MOV DOTVAL,B ;GET THE VALUE OF DOT + JSR PC,ADSYTY ;TYPE B AS SYMBOL PLUS OFFSET + CMPB SPACMD,#BMODES ;ARE WE REALLY ACCESSING MEMORY? + BGE ALF5 ;NO + CMP LFINC,#1 + BEQ ALF4 ;OPEN AS BYTE +ALF5: MOV #'/,A + JSR PC,TYO ;TYPE THE SLASH + JMP ASLAS9 + +ALF1: INC DOTVAL ;USING LF WRAPS AROUND THRU REGISTERS AS USUAL + CMP DOTVAL,#7 + BLE ALF2 + CLR DOTVAL + BR ALF2 + +ALF4: JMP ABACK0 + +CLOSE: TSTB EVSIZE+1 + BEQ CLOSE1 ;NO VALUE PECIFIED + MOV OPLOC,A + CMPB OPENWD,#1 + BEQ CLOSEB ;BYTE WAS OPEN + BLT CLOSEX ;NOTHING WAS OPEN + TSTB OPLORF + BNE CLOSB ;REGISTER WAS OPEN IN WORD MODE + TSTB EVSIZE + BNE CLOSEF ;FLOATING VALUE GIVEN + TSTB EVINSF + BNE CLOSEI ;STORE INSTRUCTION + JSR PC,WRTWRD ;WRITE VALUE FROM EVAL (IN B) AT A + MOV #2,LFINC ;WRITE 1 WORD => LFINC = 2 + BR CLOSE1 + +;BYTE WAS OPEN +CLOSEB: TSTB EVSIZE + BNE CLOSER ;FLOATING VALUE CAN'T BE STORED IN BYTE MODE + TSTB EVINSF + BNE CLOSER ;INSTRUCTION CAN'T BE STORED IN A BYTE + TSTB OPLORF + BNE CLOSRB ;REGISTER WAS OPEN IN BYTE MODE + JSR PC,WRTBYT ;WRITE VALUE IN B IN BYTE AT OPLOC + BR CLOSE1 + +;WORD WAS OPEN AND VALUE WAS FLOATING +CLOSEF: LDD LFVAL,AC0 + STD AC0,FTEMP + MOV #4,C ;SET UP C AS WORD COUNT FOR WRTBLK + TSTB DBLFMD + BNE CLOSF1 ;DOUBLE FLOATING TYPEIN + STCDF AC0,FTEMP ;SINGLE PRECISION MODE - CLOBBER 2 WORDS ONLY + MOV #2,C +CLOSF1: MOV #FTEMP,D ;ADDRESS TO COPY FROM +CLOSI1: MOV C,LFINC ;SO LF WILL INCREMENT BY THE RIGHT AMOUNT + ASL LFINC + JSR PC,WRTBLK ;WRITE C MANY WORDS FROM @D INTO @A +CLOSE1: CLRB OPENWD +CLOSEX: RTS PC + +CLOSEI: TSTB INREL ;RELOCATE INS2? + BEQ CLOSI2 ;NO + BMI CLOSI4 ;RELOCATE FOR A BRANCH. ADDRESS IS IN INS2 + SUB A,INS2 ;YES +CLOSI2: TSTB INREL+1 ;RELOCATE INS3? + BEQ CLOSI3 ;NO + SUB A,INS3 ;YES +CLOSI3: MOV #INS1,D + MOVB EVINSC,C ;INSTRUCTION WORD COUNT FROM EVAL + BR CLOSI1 + +CLOSI4: MOV INS2,B ;ADDRESS TO BRANCH TO + BIT #070000,INS1 ;IS IT AN SOB + BNE CLOSI5 ;FIX THE SOB + SUB A,B + ASR B + DEC B + CMP B,#-200 + BLT CLOSER ;BRANCH OUT OF RANGE + CMP B,#177 + BGT CLOSER ;BRANCH OUT OF RANGE + MOVB B,INS1 ;STORE CORRECT OFFSET + BR CLOSI3 + +CLOSI5: CMP A,B + BLO CLOSER ;CAN'T BRANCH FORWARD WITH SOB + NEG B + ADD A,B + ASR B + INC B + BIT #177700,B + BNE CLOSER ;CAN'T JUMP THAT FAR BACK + BIS B,INS1 + BR CLOSI3 + +CLOSER: JMP QERR + ;REGISTER WAS OPEN IN WORD MODE +CLOSB: TSTB EVSIZE + BNE CLOSBF ;STORE THE FLOATING VALUE + TSTB EVINSF + BNE CLOSER ;CAN'T TYPE INSTRUCTION INTO A REGISTER +.IFNZ LSI + TST LSICAP ;LSI? + BNE CLSLRG ;YES, CLOSE ITS REGS +.ENDC + ASL A ;CONVERT REG NUMBER TO OFFSET FROM UA + MOV B,UA(A) ;STORE REGISTER + RTS PC + +;REGISTER WAS OPEN IN BYTE MODE +CLOSRB: +.IFNZ LSI + TST LSICAP ;LSI? + BNE CLSLR1 ;YES +.ENDC + ASL A ;CONVER REG NUMBER TO OFFSET FROM UA + MOVB B,UA(A) ;STORE LOW BYTE IN REGISTER + RTS PC + +.IFNZ LSI +CLSLRG: SAVE B ;SAVE THE VALUE + JSR PC,OPNREG ;OPEN THE REGISTER + JSR PC,LSIVAL ;GET THE VALUE +CLSLR2: REST A ;JUST TO DESTROY IT + JSR PC,ADRLSI ;TYPE THE VALUE + SAVE <#15,LSICAP> ;AND CLOSE IT FOR GOOD + $BYTO + RTS PC + +CLSLR1: SAVE B + JSR PC,OPNREG ;GET THE REGISTER AS BEFORE + JSR PC,LSIVAL ;GET THE OLD VALUE + SWAB B ;GET THE TOP BYTE + MOVB B,1(P) ;AND PUT IT INTO THE TOP BYTE OF THE NEW VALUE + BR CLSLR2 ;AND DEPOSIT IT AGAIN +.ENDC + +;REGISTER WAS OPEN IN FLOAT MODE +CLOSBF: ASL A ;CONVERT REG NUMBER TO OFFSET FROM UA + LDD LFVAL,AC0 + STD AC0,UA(A) ;MOVE THE VALUE + +.SBTTL BOUNDED FUNCTIONS: SEARCHES AND ZEROING + +;SET THE BOUNDS FOR SEARCH OR ZEROING +BOUNDS: TST VALP + BNE BOUNDX ;LIMITS WERE GIVEN ANYWAY + MOV #VAL1,D + MOV USRBEG,(D)+ ;FIRST USER LOC (INITIALLY 0) + MOV USREND,(D)+ ;LAST USER LOC (INITIALLY 177777) + MOV #4,VALP +BOUNDX: CMP VAL1,VAL2 + BHI BOUNDE + TST VALRF + BNE BOUNDE ;REGISTER VALUES NOT LEGAL IN BOUNDS + RTS PC + +BOUNDE: JMP QERR + +A1MASK: JSR PC,EVSYM + TSTB EXNUMF + BEQ A1MSK1 ;NO VALUE GIVEN + JSR PC,EVPOP + JSR PC,NUMCHK + MOV B,MASK + RTS PC + +A1MSK1: CLRB EVREGF + CLRB FLTF + MOV #MASK,B + JMP A1Q3 + + +;SEARCHES + +A1EFF: MOVB #1,SRCHTY + BR SRCH + +A1NOT: MOVB #-1,SRCHTY + BR SRCH + +A1WORD: CLRB SRCHTY +;FALL INTO SRCH + +SRCH: JSR PC,EVPOP + JSR PC,NUMCHK + MOV B,TARGET ;THIS IS WHAT WE ARE LOOKING FOR + JSR PC,BOUNDS + MOV VAL1,A ;LOWER SEARCH BOUND + BIT #1,A ;CHECK FOR ODD ADRESS + BEQ SRCH1 ;ADDRESS OK + SEZ ;SIGNAL AN ERROR + ERROR ,A1GOOD ;ODD ADDRESS ERROR +SRCH1: MOV MASK,CMASK + COM CMASK +SRCHLP: SAVE A + MOV #.CRRD,C ;MAKE SURE WE HAVE READ ACCESS TO THIS WORD + JSR PC,MAPWRD ;DO WE HAVE ACCESS? + BNE SRCHL1 ;YES, CONTINUE SEARCH + REST A + ADD #2000,A ;CHECK 512 WORDS FURTHER ON + BVS SRCHD ;IF A OVERFLOWS, WE'RE DONE + CMP A,VAL2 ;ARE WE PAST THE END YET? + BHI SRCHD ;YES, DONE + BR SRCHLP ;NO, BETTER CHECK THIS LOC FOR ACCESS +SRCHL1: REST A + JSR PC,GETWRD + MOV TARGET,C + TSTB SRCHTY + BGT SRCHEF ;DO EFF SEARCH + XOR B,C + BIC CMASK,C + BEQ SRCHEQ ;THEY ARE EQUAL + TSTB SRCHTY ;UNEQUAL. IS IT "NOT WORD" SEARCH + BEQ SRCHNX ;NO, GO ON TO NEXT +SRCHY: MOV A,-(P) ;SAVE ADDRESS + JSR PC,CRLF + MOV (P),B + CLRB EVREGF + JSR PC,ATAB9 + MOV (P)+,A +SRCHNX: ADD #2,A ;ADVANCE THE POINTER + CMP A,VAL2 ;AT THE END OF THE SEARCH YET? + BHI SRCHD ;DONE + TST RESETF ;QUIT HERE? + BEQ SRCHLP ;NO, KEEP GOING +SRCHD: JMP CMD ;YES, GIVE UP NOW + +SRCHEQ: TSTB SRCHTY ;EQUAL. IS IT "WORD" SEARCH + BEQ SRCHY ;YES, TYPE IT OUT + BR SRCHNX ;NO, GO ON TO NEXT + +SRCHEF: CMP B,C + BEQ SRCHY ;EXACT MATCH IS A WIN + MOV B,D + ADD A,D + ADD #2,D + CMP D,C + BEQ SRCHY ;PC RELATIVE ADDRESS IS A WIN + SWAB B + TSTB B + BEQ SRCHNX ;NOT A BRANCH + BITB #170,B + BEQ SRCHBR ;IT'S A BRANCH + BICB #1,B + CMPB B,#077+077 ;SOB? + BNE SRCHNX ;NO + ASH #-7,B + BIC #177601,B + NEG B +SRCHB1: ADD A,B + ADD #2,B ;PC+2-2*OFFSET + CMP B,C + BEQ SRCHY + BR SRCHNX + +SRCHBR: ASH #-7,B + BIC #1,B + BR SRCHB1 + +;ZEROING FUNCTIONS ZERO A SECTION OR ALL OF THE USER'S MEMORY. +;DOES NOT CREATE OR TRY TO ZERO NON-EXISTANT PAGES. + +A2ZERO: JSR PC,BOUNDS +A1ZERO: JSR PC,EVPOP + TSTB EVSIZE+1 + BEQ A1ZEB ;NO VALUE, USE ZERO + JSR PC,NUMCHK ;MAKE SURE VALUE IS AN INTEGER +A1ZEC: MOV VALP,C + CMP C,#4 + BNE A1ZERR ;MUST HAVE EXACTLY 2 VALUES + MOV VAL1,A + MOV VAL2,C + CMP A,C + BHI A1ZERR ;MUST HAVE AC + BIT #1,A + BEQ A1ZERL + SEZ ;SIGNAL THE ERROR + ERROR ,A1GOOD ;ODD ADDRESS ERROR +A1ZERL: SAVE + MOV #.CRWRT,C ;READ-WRITE ACCESS + JSR PC,MAPWRD ;DO WE HAVE THIS ACCESS TO THIS WORD? + BNE A1ZER1 ;YES, GO AHEAD AND WRITE INTO IT + REST ;ELSE CHECK FURTHER ON + ADD #2000,A ;IN PARTICULAR, 512 WORDS FURTHER ON + BVS A1ZER3 ;IF A OVERFLOWS, WE'RE DONE + BR A1ZER2 ;NOW SEE IF WE'RE PAST THE END +A1ZER1: REST + JSR PC,WRTWRD + ADD #2,A +A1ZER2: CMP A,C + BLOS A1ZERL +A1ZER3: JMP CMD + +A1ZEB: CLR B + BR A1ZEC + +A1ZERR: JMP QERR + + +.SBTTL ALTMODE FUNCTIONS + +AALTR: JMP QERR + +AALT: CLRB ALTVF + CLRB ALTPVF + CLR D ;TWO ALTS FLAG +AALT1: JSR PC,TYI ;GOBBLE CHARACTER AFTER ALT MODE + TST A + BEQ AALTR ;NULL CHAR IS ERROR + CMP A,#33 + BEQ AALTAL ;SECOND ALT MODE + BLT ALTCTL ;DO ALT CONTROL DISPATCH + CMP A,#'( + BEQ AALTLP + CMP A,#'0 + BLT AALTR + CMP A,#'7 + BLE AALTN ;GOT A NUMBER + CMP A,#'A + BLT AALTR + CMP A,#'Z + BGT AALTR + ASL A + ADD D,A + JMP @ALTTB-'A-'A(A) ;DIPATCH ON LETTER + +AALTN: SUB #'0,A + MOVB A,SALTNM ;SAVE VALUE AFTER ALT MODE + INCB ALTVF ;INDICATE THERE IS A VALUE IN SALTNM + BR AALT1 + +AALTAL: MOV #ALT2TB-ALTTB,D ;INDICATE HAVING RECEIVED SECOND ALT MODE + BR AALT1 + +ALTCTL: ASL A ;CONVERT TO WORD INDEX + ADD D,A ;ADD THE OFFSET CAUSED BY SECOND ALT + JMP @ACTLTB-2(A) ;DISPATCH OFF CONTROL CHAR + +AALTLP: JSR PC,EVPOP + JSR PC,NUMCHK ;MAKE SURE WE HAVE INTEGER VALUE + MOV B,-(P) ;SAVE VALUE + MOVB #'(,SNEAK1 ;PUT BACK LEFT PAREN + INCB EVINLF ;CAUSE EVALI TO RETURN AFTER CLOSED PAREN + CLRB EVINSF + JSR PC,EVALI ;READ EXPRESSION IN PARENS + CLRB EVINLF ;CLEAR THE FLAG FOR FURTHER CALLS ON EVALI + INCB ALTPVF ;INDICATE VALUE IN PARENS GIVEN AFTER ALT + INCB POPF ;IN CASE WE TRY TO EVPOP AGAIN + MOVB EVREGF,ALPVRF ;SAVE INFO OF VALUE IN PARENS BEING A REG + MOV B,ALTPV ;SAVE VALUE + MOV (P)+,B ;GET VALUE BEFORE () BACK + MOV #400,EVSIZE + CLRB EVREGF + CLRB EVINSF + BR AALT1 + +A1ABS: INCB ABSMD ;$A + BR A1RET + +A1REL: CLRB ABSMD ;$R + BR A1RET + +A1DEC: INCB DECMD ;$D + BR A1RET + +A1OCT: CLRB DECMD ;$O + BR A1RET + +A1CLRM: CLRB SYMBMD + CLRB INSTMD + CLRB HALFMD + CLRB BYTEMD + CLRB FLTYMD + CLRB TXTMD + CLRB TXT5MD + RTS PC + +A1CNST: JSR PC,A1CLRM ;$C + BR A1RET + +A1HALF: JSR PC,A1CLRM ;$H + INCB HALFMD + BR A1RET + +A1INST: JSR PC,A1CLRM ;$I + INCB INSTMD + BR A1RET + +A1SYMB: JSR PC,A1CLRM ;$S + INCB SYMBMD + BR A1RET + +A1BYTE: JSR PC,A1CLRM ;$Y + INCB BYTEMD + BR A1RET + +A1TXT: JSR PC,A1CLRM ;$T OR $7T OR $5T + TSTB ALTVF + BEQ A1TXT1 ;$T + CMPB SALTNM,#5 + BEQ A1TXT2 + CMPB SALTNM,#7 + BNE A1TXTR +A1TXT1: INCB TXTMD + BR A1RET + +A1TXT2: INCB TXT5MD ;$5T + BR A1RET + +A1TXTR: JMP QERR + +A1FLT: JSR PC,A1CLRM ;$F + INCB FLTYMD +A1RET: TST D + BEQ A1RET2 ;ONE ALT RETURN +A2RET2: JMP CMD2 ;RETURN FOR 2 ALTS +A1RET2: TSTB EXSYMF + BNE A1RET1 ;THERE WAS SOMETHING BEFORE THE ALT + TSTB EXNUMF + BNE A1RET1 ;THERE WAS SOMETHING BEFORE THE ALT + MOV #1,E ;THIS MEANS OPEN IN WORD MODE TO ASLASH + BIT #1,DOTRGW ;IS DOT A REGISTER? + BEQ .+6 ;NO + JMP ASLAS1 ;DON'T CHECK FOR ODD LOCATION + JMP ASLAS8 ;REOPEN CURRENT LOCATION AND TYPE CONTENTS + +A1RET1: JSR PC,TYI ;GET NEXT CHAR. MUST BE SEPARATOR + JMP EVALCE ;AND LOOK LIKE WE JUST RETURNED FROM EXPR + +A1DBL: INCB DBLFMD ;$L + BR A2RET2 + +A1FLTI: INCB FLTIMD ;$V + BR A2RET2 + +A1IPC: MOVB #IMOD,SPACMD ;SAY MAKE REFERENCE IN I SPACE + BR A1RET + +A1DPC: MOVB #DMOD,SPACMD ;SAY TO MAKE REFERENCE IN D SPACE + BR A1RET + +A1CAPS: MOVB #CPMOD,SPACMD ;SAY TO MAKE REFERENCE IN CAPABILITIES + BR A1RET + +A1UPT: MOVB #MPMOD,SPACMD ;SAY TO MAKE REFERENCE IN MAP + BR A1RET + +A1SYS: MOVB #SYMOD,SPACMD ;SAY ACCESSES TO THE SYSTEM PAGES + BR A1RET + +A2RET: JMP @ALTTB+-'A-'A(A) ;DIPATCH TO FIRST ALT TABLE +A2CRET: JMP @ACTLTB+-2(A) ;DISPATCH TO FIRST CONTROL ALT TABLE + + +A2ABS: INCB PABSMD ;$$A + BR A2RET + +A2REL: CLRB PABSMD ;$$R + BR A2RET + +A2DEC: INCB PDECMD ;$$D + BR A2RET + +A2OCT: CLRB PDECMD ;$$O + BR A2RET + +A2CLRM: CLRB PSYMBM + CLRB PINSTM + CLRB SPHALFM + CLRB PBYTEM + CLRB PFLTYM + CLRB PTXTMD + CLRB PTXT5M + RTS PC + +A2CNST: JSR PC,A2CLRM ;$$C + BR A2RET + +A2HALF: JSR PC,A2CLRM ;$$H + INCB SPHALFM + BR A2RET + +A2INST: JSR PC,A2CLRM ;$$I + INCB PINSTM + BR A2RET + +A2SYMB: JSR PC,A2CLRM ;$$S + INCB PSYMBM + BR A2RET + +A2TXT: JSR PC,A2CLRM ;$$T OR $$7T OR $$5T + TSTB ALTVF + BEQ A2TXT1 ;$$T + CMPB SALTNM,#5 + BEQ A2TXT2 + CMPB SALTNM,#7 + BNE A1TXTR +A2TXT1: INCB PTXTMD + BR A2RET + +A2TXT2: INCB PTXT5M ;$$5T + BR A2RET + +A2BYTE: JSR PC,A2CLRM ;$$Y + INCB PBYTEM + BR A2CRET + +A2FLT: JSR PC,A2CLRM ;$$F + INCB PFLTYM + BR A2RET + +A2DBL: CLRB DBLFMD ;$$L + JMP CMD2 + +A2FLTI: CLRB FLTIMD ;$$V + JMP CMD2 +ISPACE: MOV #<<<'I-100>*2>+ALT2TB-ALTTB>,A ;MAGIC DISPATCH CONSTANT +A2IPC: MOVB #IMOD,PSPCMD ;PERMANENT SPACE IS I SPACE + BR A2CRET +DSPACE: MOV #<<<'W-100>*2>+ALT2TB-ALTTB>,A ;SAME AS ABOVE +A2DPC: MOVB #DMOD,PSPCMD ;PERMANENT SPACE IS D SPACE + BR A2CRET +CAPMOD: MOV #<<<'C-100>*2>+ALT2TB-ALTTB>,A +A2CAPS: MOVB #CPMOD,PSPCMD ;PERMANENT SPACE IS CAPABILITIES + BR A2CRET +MAPMOD: MOV #<<<'U-100>*2>+ALT2TB-ALTTB>,A +A2UPT: MOVB #MPMOD,PSPCMD ;PERMANENT SPACE IS UPT MAP + BR A2CRET +SYSMOD: MOV #<<<'S-100>*2>+ALT2TB-ALTTB>,A +A2SYS: MOVB #SYMOD,PSPCMD ;PERMANENT SPACE IS THE SYSTEM CORE + BR A2CRET + +;A1Q, ACOMMA, A1HK, A2SYKL + +A1Q: TSTB ALTVF ;WAS THERE A VALUE AFTER THE ALT? + BEQ A1Q1 ;NO + TSTB LVFLTF + BNE A1QERR ;LAST VALUE WAS FLOATING + TSTB LVREGF + BNE A1QERR ;LAST VALUE WAS REGISTER + MOV LVAL,B + BITB #1,SALTNM + BEQ A1Q2 + SWAB B +A1Q2: BIC #177400,B ;GET APPROPRIATE BYTE + CLRB EVREGF + CLRB FLTF + BR A1Q3 + +A1Q1: BISB LVREGF,EVREGF ;COPY REGISTER FLAG + MOVB LVFLTF,FLTF ;AND FLOATING VALUE FLAG + MOV LVAL,B ;AND INTEGER VALUE + LDD LFVAL,AC0 + STD AC0,FLT1 ;AND FLOATING VALUE +A1Q3: INCB EXNUMF + CLRB EXSYMF + JSR PC,TYI + JMP EVALCE + +A1QERR: JMP QERR + +ACOMMA: JSR PC,TYI + CMP A,#', + BNE A1QERR + TSTB EVSIZE+1 + BNE ACOMM1 + INCB EVSIZE+1 ;NO VALUE GIVEN, INVENT ZERO + CLR B +ACOMM1: TSTB EVSIZE + BNE A1QERR ;FLOATING,, IS ILLEGAL + TSTB EVINSF + BNE A1QERR ;INSTRUCTION,, IS ILLEGAL + TSTB EVREGF + BNE A1QERR ;REGISTER,, IS ILLEGAL + CLRB POPF + CLRB EVNOVF + MOV #OPPDL,F ;SET UP OP PDL + MOV #VALPDL,E ;SET UP VAL PDL + CLR -(F) ;PUSH INITIAL ZERO + CLR D ;PRECEDENCE ZERO + MOV #7*2,C ;OPERATOR NUMBER 7 + JMP ACOMME ;PUT OP AND VALUE ON THE STACK + +A1HK: TSTB EXSYMF + BEQ A1QERR ;NO SYMBOL GIVEN + JSR PC,SYMLK ;LOOK FOR THE SYMBOL + BR A1HKUN ;NO SUCH SYMBOL + MOV REGWAD,C ;ADDRESS OF THE REGISTER WORD FOR THIS SYMBOL + BIS D,-2(C) ;SET THE HALF KILL BIT IN THE HALF KILL WORD + RTS PC + +A1HKUN: JMP EVSYM2 ;GIVE ?U? ERROR + +A2SYKL: MOV #LSTSY,SYMEND + JMP CMD2 + ;A1XCT, ASSTEP + +A1XCT: JSR PC,EVPOP + TSTB EVSIZE+1 + BEQ A1XCTR ;NO VALUE GIVEN + TSTB EVINSF + BEQ A1XCTR ;NO INSTRUCTION GIVEN + MOV XCTSYM,SYM ;QUOPAT CONTAINS "%CSX" IN RADIX 50 + MOV XCTSYM+2,SYM1 + JSR PC,SYMLK ;LOOK UP SYMBOL IN SYM AND SYM1 + BR A1XCTR ;SYMBOL "%CSX" NOT FOUND + BIT D,@REGWAD ;SYMBOL FOUND, IS IT A REGISTER? + BNE A1XCTR ;YES + MOV 4(B),B ;B CONTAINS VALUE OF %CSX + SAVE B ;B CONTAINS THE VALUE OF %CSX + TSTB INREL ;RELOCATE INS2? + BEQ A1XCT2 ;NO + BMI A1XCT4 ;RELOCATE FOR A BRANCH. ADDRESS IS IN INS2 + SUB B,INS2 ;YES +A1XCT2: TSTB INREL+1 ;RELOCATE INS3? + BEQ A1XCT3 ;NO + SUB B,INS3 ;YES +A1XCT3: MOV #240,A +A1XCT7: CMPB EVINSC,#3 + BGE A1XCT6 + MOV A,@INP + ADD #2,INP + INCB EVINSC + BR A1XCT7 + +A1XCT4: BIT #070000,INS1 ;IS IT AN SOB + BNE A1XCT5 ;FIX THE SOB +A1XCT1: MOV #000137,INS1 ;TURN INSTRUCTION INTO A JMP FOO + INCB EVINSC ;RESTORE INSTRUCTION WORD COUNT TO TWO + BR A1XCT3 + +A1XCT5: MOV @B,A + ASH #-5,A + BIC #177761,A + DEC UA(A) ;DO THE DECREMENT + BNE A1XCT1 ;HAVE TO BRANCH + MOV #240,@B ;EXECUTE A NOP INSTEAD (MAYBE WILL INT) + MOV #1,EVINSC + BR A1XCT3 + +A1XCT6: MOV #INS1,D ;D IS "FROM" LOCATION IN WRTBLK + MOV #4,C ;C IS COUNT IN WRTBLK + MOV (P),A ;GET BACK THE ADDRESS TO WRITE TO + JSR PC,WRTBLK ;WRITE THE INSTRUCTION INTO INFERIOR SPHERE + MOV A,XCTLOC ;A SET BY WRTBLK TO VALUE OF PAT+8 + ;THIS IS WHAT THE PC SHOULD BE AFTER EXECUTING + MOV UPC,SVUPC ;SAVE UPC IN CASE WE COME BACK + REST B ;AT XCTGO, B GETS PUT IN UPC + JMP XCTGO + +A1XCTR: JMP QERR + +.SBTTL SINGLE STEP, PROCEED AND GO + +;SINGLE STEP +ASSTEP: TSTB PROCF + BEQ ASSTP5 ;QERR, HAVE TO BE PROCEEDABLE FIRST + MOVB #IMOD,SPACMD ;FORCE CURRENT MODE TO I SPACE + JSR PC,EVPOP ;TEST FOR ^S. + TSTB EVSIZE+1 + BNE ASSTP1 ;THERE IS AN , USE AS SSCNT + MOV #1,SSCNT ;STEP 1 INSTRUCTION + BR ASSTP2 + +ASSTP1: JSR PC,NUMCHK + MOV B,SSCNT ;SINGLE STEP THIS MANY TIMES + +ASSTP2: MOV UPC,A ;ALSO ENTER HERE FROM MULTIPLE STEP BREAK + MOV #.CRRD,C ;SAY THAT WE WANT TO READ + JSR PC,MAPWRD ;CHECK THE VALIDITY OF THAT ADDRESS + ERROR ,CMD + MOV UPC,A + BIT #1,A ;LOOK OUT FOR ODD ADDRESS. + BNE ASSTP4 + JSR PC,GETWRD ;NOW FOR A HORRENDOUS HACK... + MOV B,C + BIC #7,C + CMP C,#230 ;IS THE INSTRUCTION BEING ONE-STEPPED + BNE ASSTP3 ;A PL? + BIC #177770,B ;IT IS. WE HAVE TO SIMULATE IT BECAUSE + ASH #5,B ;PL INHIBITS TRACE TRAPPING. + BIC #340,UST + BIS B,UST + MOV UPC,B + ADD #2,B ;UPDATE USERS PC + MOV B,UPC + JMP BPTSS ;PRETEND WE GOT A TRACE TRAP. + +ASSTP3: JMP SSTEP +ASSTP4: JMP A1GOOD +ASSTP5: JMP QERR + + + +A2GO: TST SPHCAP ;SPHERE? + BEQ GONSPH ;NOPE + SAVE <,,SPHCAP> ;KILL ALL THE PROCESSES IN SPHERE + BIS #.SPKIL*400,(P) ;SET IN FUNCTION TO KILL ALL OF THEM + $INVOK ;SHOULD ALWAYS WIN + JSR PC,NEWPR ;CREATE A NEW PROCESS + BR A1GO5 ;NOW JUST PROCED LIKE $G + +A1GO1: MOV SADDR,B + BR A1GO4 + +A1GO: +.IFNZ LSI + TST LSICAP ;LSI MODE + BNE A1GO5 ;YES +.ENDC + TST SPHCAP ;TST TO SEE IF THERE IS A SPHERE + BNE A1GO5 ;NOPE +GONSPH: TYPEIT + JMP CMD +A1GO5: JSR PC,EVPOP + TSTB EVSIZE+1 + BEQ A1GO1 ;JUST $G. START AT STARTING ADDRESS + JSR PC,NUMCHK ;VALUE GIVEN, MAKE SURE IT'S AN INTEGER +A1GO4: CLRB PROCF + CLRB LBPTN + BIT #1,B + BNE A1GOOD ;ODD STARTING ADDRESS +XCTGO: MOV B,UPC + JSR PC,BPTINC +A1GO2: +.IFNZ LSI + TST LSICAP ;DEBUGGING LSI? + BNE A1GOLS ;YES +.ENDC + MOV UPC,A + MOVB #IMOD,SPACMD ;PUT US TEMPORARILY IN I SPACE + MOV #.CRRD,C ;WE WANT TO EXECUTE AT THIS ADDRESS + JSR PC,MAPWRD ;MAKE SURE WE CAN + ERROR ,NXMTRP + CLR PFAULT ;READY THE PROCESS + JSR PC,RESTST ;RESTORE THE WORLD AND START THE PROCESS + INVOK. PRCAP,#<.PRWRT+.PRSTOP>*400,#0 + DELCAP PRCAP ;GET RID OF THE PROCESS CAP SINCE + ;WE GET A NEW ONE EACH TIME THE PR FAULTS + SAVE DDTLOK + .QUNLK ;ALLOW ANOTHER DDT TO START + ERRORB ;FATAL ERROR IF THIS LOSES + .POOFF ;KILL THIS PROCESS, OTHER DDT PROCESS MAY ALREADY EXIST +.IFNZ LSI +A1GOLS: MOV MEMT,B ;GET THE TOP ADDRESS OF MEMORY + SUB #RESOFF,B ;SUBTRACT RESIDENT OFFSET FROM TOP TO GET START OF RESIDENT + SAVE B ;SAVE IT + MOV #14,A ;BPT TRAP LOCATION + JSR PC,WRTWRD ;WRITE IT + MOV #16,A ;NOW THE STATUS + MOV #340,B ;NO INTERRUPTS + JSR PC,WRTWRD ;WRITE IT + REST A ;THE ADDRESS TO WRITE TO + MOV #/2,C ;THE NUMBER OF WORDS TO WRITE + MOV #LSIBOT,D ;THE ADDRESS OF [ HALT ? BIS #20,2(P) ? RTT ] + JSR PC,WRTBLK ;WRITE THE BLOCK + JSR PC,CLRLSI ;CLEAR THE BUFFER + MOV UPC,A ;GET THE STARTING ADDRESS + JSR PC,ADRLSI ;TYPE THE ADDRESS + MOV #'G,A ;THE GO COMMAND + SAVE ;OUTPUT THE GO COMMAND + $BYTO ;OUTPUT IT +A1GOLP: SAVE LSICAP ;GET A BYTE + $BYTI + CMPB (P)+,A ;WAIT FOR THE LSI TO ECHO THE G + BNE A1GOLP ;NOT YET + JMP TTYWAT ;WAIT FOR THE LSI TO TYPE 6 NUMBERS AND CR-LF @ +.ENDC +A1GOER: JSR PC,SAVES1 ;GET THE TTY BACK + TYPEIT + JMP CMD +A1GOOD: TYPEIT < ?ODD? > + JMP CMD1 + +A1PRER: CLR A2PF ;IN CASE WE DID A A2PRO + JMP QERR + +A1PRO1: MOV #1,B + BR A1PRO2 +A2PROQ: DECB A2PF ;^P SI LIKE $$P BUT DOES NOT TYPE OUT + BR A1PRO ;AT BREAKPOINTS + +A2PRO: INCB A2PF ;LIKE $P BUT DOES AUTOMATIC $P UPON BREAKING +A1PRO: JSR PC,EVPOP + TSTB EVSIZE+1 + BEQ A1PRO1 ;NO VALUE IS LIKE 1$P + JSR PC,NUMCHK +A1PRO2: TSTB PROCF + BEQ A1PRER ;PROCEED NOT ALLOWED NOW + BIT #1,UPC + BNE A1GOOD + MOVB PROCF,A + MOV B,BPTCNT-2(A) ;STORE PROCEED COUNT + + ;THERE ARE SOME CONFUSING FEATURES TO PROCEDE AND SINGLE STEP. IF WE ARE +;PROCEDING FROM A BREAKPOINT, AT LEAST 1 INSTRUCTION MUST BE EXECUTED BEFORE +;WE CAN HIT ANOTHER BREAKPOINT. THE FOLLOWING CODE CHECKS TO SEE IF THE FIRST +;INSTRUCTION TO BE EXECUTED IS A BREAKPOINT. IF IT IS, THEN 1 INSTRUCTION IS +;EXECUTED IN SINGLE STEP MODE (NOT THE BREAKPOINT), THEN THE BREAKPOINT IS +;RE-INSTALLED AND THE PROGRAM PROCEEDS NORMALLY. IN SINGLE STEP MODE, BREAK +;POINTS ARE IGNORED. THE FIRST NON-BREAK INSTRUCTION IS STEPPED. +PROCED: BIC #20,UST + JSR PC,PROCE1 +.IFNZ LSI + TST LSICAP ;LSI? + BEQ SSTEP1 ;NO +.IFF + BR SSTEP1 +.IFT + BIT #TBIT,UST ;SINGLE STEP? + BNE LSIPRO ;YES, FORGET THIS BROOHAHA + MOV #7,A ;GET THE PC + MOV MEMT,B + SUB #GOOFF,B ;START IT AT THE RIGHT PLACE + JSR PC,CLSLRG ;DEPOSIT IT INTO THE PC +LSIPRO: SAVE <#'P,LSICAP> ;OUTPUT A PROCEDE COMMAND + $BYTO +LSIPR1: SAVE LSICAP ;WAIT FOR THE P + $BYTI ;GET A BYTE + CMPB (P)+,#'P ;P? + BNE LSIPR1 ;NOT YET + JMP TTYWAT +.ENDC + +SSTEP: BIS #20,UST + JSR PC,PROCE1 + CLRB LBPTN +.IFNZ LSI + TST LSICAP ;LSI? + BNE LSIPRO ;YES, JUST TELL IT TO PROCEDE +.ENDC +SSTEP1: JMP A1GO2 ;JUST START HIM + +PROCE1: MOV UPC,B ;CHECK TO SEE IF NEXT INST IS BPT, AND IF SO AVOID IT + JSR PC,BPTSRC ;BPTSRC SEARCHES FOR A BREAKPOINT AT LOC IN B + TST A ;NOOP, BPTSRC SKIP RETURNS WHEN IT FINDS A BPT HERE + MOVB A,LBPTN ;BPTSRC LEAVES THE INDEX OF THE BPT IT FOUND IN A + BEQ PROCE2 ;IF NOT BREAK PT IS FOUND, IT LEAVES 0 IN A + BIS #TBIT,UST ;IF BPT IS FOUND, LEAVE IT OUT FOR 1 INST, THEN PUT BACK +PROCE2: JMP BPTINC ;INSTALL ALL BPTS EXCEPT THE ONE WHOSE INDEX IS IN A + +;A1PRER: JMP QERR + +.SBTTL BREAKPOINTS + +A1BRK: JSR PC,EVPOP + JSR PC,NUMCHK ;MAKE SURE WE HAVE AN INTEGER VALUE + TST B + BEQ A1BRK2 ;FLUSH NUMBERED BREAKPOINT + MOV B,A ;COPY THE PROPOSED BPT ADDRESS + MOV #.CRWRT,C ;WE HAVE TO WRITE TO PUT IN A BPT + JSR PC,MAPWRD ;CHECK IF THIS ADDRESS IS VALID + ERROR ,NXMTRP + JSR PC,BPTSRC ;SEE IF THERE IS ALREADY A BPT AT THIS ADDRESS + BR A1BRK2 ;NO + CLR BPTADR-2(A) ;YES FLUSH OLD +A1BRK2: TSTB ALTVF + BNE A1BRK6 ;NUMBER WAS TYPED AFTER ALT + MOV #2,A ;SEARCH FOR A FREE BREAKPOINT SLOT +A1BRK4: TST BPTADR-2(A) + BEQ A1BRK5 ;FOUND ONE + ADD #2,A ;NEXT BPT + CMP A,#NBPTS*2 + BLE A1BRK4 + TYPEIT < ?TMB? > ;TOO MANY BREAKPOINTS + JMP CMD1 + +A1BRKR: JMP QERR + +A1BRK6: MOVB SALTNM,A + BEQ A1BRKR ;NO BREAKPOINT ZERO + CMP A,#NBPTS ;VALUE TOO HIGH? + BGT A1BRKR ;YES, ERROR + ASL A ;MAKE INTO AN INDEX +A1BRK5: MOV B,BPTADR-2(A) ;STORE ADDRESS OF THE BREAKPOINT + CLR BPTCNT-2(A) ;SET COUNT TO ZERO + CLRB BPTRGF-2(A) ;NO LOCATION TO TYPE + TSTB ALTPVF + BNE A1BRK7 ;LOCATION TO TYPE OUT +A1BRKX: JMP CMD2 + +A1BRK7: MOV ALTPV,BPTLOC-2(A) + INCB BPTRGF-2(A) + TSTB ALPVRF + BEQ A1BRKX ;NOT A REGISTER + MOVB #-1,BPTRGF-2(A) + BR A1BRKX + +BPTFLS: MOV #NBPTS*2+2,A +BPTFL1: CLR BPTADR-2(A) + DEC A + SOB A,BPTFL1 + RTS PC + +A2BRK0: JSR PC,BPTFLS ;FLUSH ALL BREAKPOINTS + BR A1BRKX + +A2BRK: JSR PC,EVPOP ;$$B -- WAS AN EXPRESSION TYPED? + TSTB EVSIZE+1 + BEQ A2BRK0 ;NO, CLEAR ALL BREAKPOINTS. + JSR PC,NUMCHK ;YES. MAKE SURE IT'S AN INTEGER + JSR PC,BPTSRC ;IS THERE A BREAKPOINT HERE? + BR A1BRKX ;NO, SCREW IT + CLR BPTADR-2(A) ;YES, GET RID OF IT. + BR A1BRKX + +BRKPR1: MOV DOTVAL,A + BR BRKPR2 +BRKPRO: JSR PC,EVPOP ;^P -- CHECK FOR AN EXPRESSION + TSTB EVSIZE+1 + BEQ BRKPR1 ;NO EXPRESSION, DEFAULTS TO . + JSR PC,NUMCHK +BRKPR2: JSR PC,BPTSRC ;IF THERE IS ALREADY A BREAKPOINT HERE, + BR BRKPR3 + CLR BPTADR-2(A) ;GET RID OF IT +BRKPR3: MOV #NBPTS*2+2,A ;SET BREAKPOINT NO. TO 8. + MOV A,BPTADR-2(A) ;PLANT THE BREAKPOINT, + JMP A1PRO1 ;AND PROCEED + +;PUT INSTRUCTIONS BACK WHERE THE BREAKPOINTS ARE +BPTRST: MOV #NBPTS*2+2,A +BPTRS2: TST BPTADR-2(A) + BEQ BPTRS1 ;NO BREAKPOINT HERE + SAVE ;GET SOME REGISTERS + MOV BPTINS-2(A),B ;GET THE INSTRUCTION THAT LIVES AT THE LOC OF THIS BPT + MOV BPTADR-2(A),A ;GET THE ADDRESS OF THIS BREAKPOINT + JSR PC,WRTWRD ;WRITE THE INSTRUCTION BACK + REST +BPTRS1: DEC A + SOB A,BPTRS2 + RTS PC + +;PUT BPTS IN CORE EXCEPT FOR THE ONE AT BREAKPOINT # LBPTN +BPTINC: MOVB #IMOD,SPACMD ;PUT US TEMPORARILY IN I SPACE + MOV #NBPTS*2+2,C + MOVB LBPTN,D +BPTIN1: MOV BPTADR-2(C),A ;ADDRESS OF THIS BPT + BEQ BPTIN2 ;NO BREAKPOINT HERE + JSR PC,GETWRD + MOV B,BPTINS-2(C) ;GET COPY OF WHAT'S THERE NOW + CMP C,D + BEQ BPTIN2 + MOV #BPTOP,B + JSR PC,WRTWRD +BPTIN2: DEC C + SOB C,BPTIN1 + RTS PC + +;SEARCH FOR BREAKPOINT AT ADDRESS B. RETURN INDEX INTO BREAKPOINT TABLES +;IN A AND SKIP RETURN IF FOUND +BPTSRC: MOV #NBPTS*2+2,A +BPTSC: CMP BPTADR-2(A),B + BEQ BPTSD ;FOUND THE ENTRY FOR THIS BREAKPOINT + DEC A + SOB A,BPTSC + RTS PC + +BPTSD: ADD #2,(P) + RTS PC + + ;BPTTRP IS THE ENTRY POINT INTO DDT FOR BREAKPOINTS AND TRAPS +BPTTRP: +.IFNZ LSI + TST LSICAP ;LSI? + BEQ BPTTR1 ;NO + MOV #.BPTTF,PFAULT ;PRETEND IT WAS BPT UNTIL FURTHER NOTICE + JSR PC,BPTRST ;RESTORE THE INSTRUCTIONS + MOV #7,A ;GET THE PC + JSR PC,OPNREG ;OPEN IT + JSR PC,LSIVAL ;AND GET ITS VALUE + MOV MEMT,A ;THE TOP OF MEMORY + SUB #BPTOFF,A ;GET THE ADDRESS OF INSTRUCTION AFTER THE HALT + CMP A,B ;SAME PLACE? + BEQ BPTTR2 ;YES, MUST BE BPT + MOV #.ILLTF,PFAULT ;CHANGED MIND MUST BE RANDOM HALT +BPTTF2: JMP BPTTF1 ;LOSEY LOSEY +BPTTR1: +.IFTF + CMPB PFAULT,#.BPTTF ;WAS IT A STRANGE TYPE FAULT? + BNE BPTTF2 ;YES +.IFT +BPTTR2: +.ENDC + BIT #TBIT,UST ;WAS THE PROCESS RUNNING IN TRACE MODE? + BEQ BPTTB ;NO, BEGIN BREAKPOINT PROCESSING + TSTB LBPTN ;HAVE WE TRIED TO PROCEED OVER A BREAKPOINT? + BEQ BPTTB ;NO, CONTINUE WITH NORMAL BPT AND SS PROCESSING + CLRB LBPTN ;YES, THERE WAS A BREAKPOINT AS OUR NEXT INSTRUCTION + ;WHEN WE TRIED TO PROCEED, BUT WE HAVE NOW PASSED IT. + JSR PC,BPTINC ;INSERT THE BREAKPOINTS INTO CORE + BIC #TBIT,UST ;FLUSH TRACE MODE +.IFZ LSI + JMP A1GO2 ;PROCEED NORMALLY +.IFF + TST LSICAP ;LSI? + BNE 1$ ;YES + JMP A1GO2 ;PROCEED NORMALLY +1$: MOV MEMT,B ;START IT AT THE RTI + MOV #7,A ;DEPOSIT IT INTO THE PC + JSR PC,CLSLRG + JMP LSIPRO +.ENDC + +BPTTB: +.IFNZ LSI + TST LSICAP ;LSI? + BEQ BPTTB1 ;NO + MOV #6,A ;GET THE STACK POINTER + JSR PC,OPNREG + JSR PC,LSIVAL ;GET ITS VALUE + MOV B,A ;GET THE VALUE AT THE TOP OF THE STACK + MOV A,UP ;POINTER TO TOP OF STACK (PC) + JSR PC,GETWRD ;GET THE WORD INTO B + MOV B,UPC ;JUST FOR RANDOMNESS +BPTTB1: +.ENDC + + MOV UPC,B ;GET THE USER'S PC + SUB #2,B ;BACK IT UP TO WHERE A BPT MIGHT BE. + JSR PC,BPTSRC ;DO WE HAVE A BREAKPOINT SET HERE? + BR BPTTD ;NO. + BIT #20,UST ;YES. IF THE T BIT IS ON, WE JUST + BNE BPTTD ;STEPPED THAT INSTRUCTION. + JSR PC,BPTMP ;IF BREAKPOINT IS NO. 8, STOP $$P'ING + MOV B,UPC ;WE DIDN'T. SAVE THE CORRECTED PC. + DEC BPTCNT-2(A) ;TIME TO BREAK HERE? + BGT BPTRT3 +BPTR2A: CLR BPTCNT-2(A) ;YES. + TSTB A2PF ;ARE WE ^Q'ING? + BPL BPTTR4 + MOVB A,LBPTN + TST RESETF ;QUIT HERE? + BEQ BPTR2B ;NO, PROCEED + CLRB A2PF ;YES,BREAK + MOVB LBPTN,A + BR BPTTR4 + +BPTR2B: JMP PROCED +BPTRT3: TST RESETF ;QUIT HERE? + BNE .+6 + JMP PROCED + MOVB LBPTN,A + BR BPTR2A + +BPTTD: ADD #2,B ;WE DIDN'T HIT A BREAKPOINT. ARE WE +.IFNZ LSI + TST LSICAP ;DEBUGP LSI? + BEQ BPTTD1 ;NO + ADD #2,B ;BECAUSE THE LSI RESIDENT SUBS 2 + MOV UP,A ;ADDRESS OF TOP OF STACK + JSR PC,WRTWRD ;WRITE THE PC+2 +BPTTD1: +.ENDC + CMP B,XCTLOC ;DID WE DO AN EXECUTE + BEQ BPTTE ;YES +BPTSS: JSR PC,BPTSRC ;ABOUT TO STEP INTO ONE? + BR BPTTF ;NO. + JSR PC,BPTMP +BPTTR4: MOVB A,PROCF + MOVB A,LBPTN ;EITHER WE RAN INTO A BREAKPOINT OR + MOV A,B ;WE'RE ABOUT TO STEP INTO ONE. + ASR B + JSR PC,CRLF + TYPEIT <$> + JSR PC,NTYPE ;TYPE THE BREAKPOINT NUMBER + TYPEIT + BR BPTTYP ;TYPE THE REST OF THE MESSAGE + +BPTTE: MOV SVUPC,UPC ;RESTORE THE PC + JMP CMD ;GET THE NEXT COMMAND + +BPTTF: BIT #20,UST ;NOT AT A BREAKPOINT. IF T BIT IS OFF, + BNE BPTTR6 +BPTTF1: JSR PC,CRLF + MOV PFAULT,B ;ASSUME A FAULT ENTRY INTO DDT, PUT FAULT NUMBER IN B + JSR PC,FLTTYP ;TYPE THE NAME OF THE FAULT + TYPEIT <; > ;WE JUST ENTERED DDT + BR BPTTR7 + +BPTTR6: DEC SSCNT ;ARE WE FINISHED STEPPING YET? + BEQ .+6 ;YES, PRINT THE MESSAGE AND QUIT + JMP ASSTP2 ;NO, GET READY TO GO AGAIN + JSR PC,CRLF + TYPEIT + +BPTTR7: CLRB LBPTN ;REMEMBER THAT WE'RE NOT AT A BREAKPOINT. + CLRB A2PF + MOVB #8*2,PROCF + +BPTTYP: BIC #20,UST ;DONE WITH THE TRACE BIT FOR NOW... + MOV UPC,B + JSR PC,SYTYPE ;TYPE THE LOCATION OF THE INSTRUCTION. + MOV #'>,A + JSR PC,TYO + JSR PC,TYO + MOV UPC,A + MOV A,INSLOC + BIT #1,A ;CHECK FOR ODD ADDRESS + BEQ BPTTY5 ;OK + TYPEIT + BR BPTTY6 +BPTTY5: JSR PC,GETWRD ;GET THE INSTRUCTION + MOV B,INSVAL + JSR PC,INSTTY ;AND TYPE IT. +BPTTY6: MOVB LBPTN,A ;ARE WE AT A BREAKPOINT? + BEQ BPTTY2 + MOV BPTLOC-2(A),B ;YES. GET THE LOCATION ASSOCIATED + CLRB EVREGF ;WITH THE BREAKPOINT. + TSTB BPTRGF-2(A) + BEQ BPTTY2 ;ARE WE SUPPOSED TO TYPE IT OUT? + BPL BPTTY1 ;YES. + INCB EVREGF +BPTTY1: CLRB LBPTN + TYPEIT < > + JSR PC,ATAB9 ;DO IT. +BPTTY2: TSTB A2PF ;DOING A $$P? + BNE BPTTY3 + JMP CMD2 ;NO. GO LISTEN TO THE USER. +BPTTY3: TST RESETF ;YES. QUIT HERE? + BEQ BPTRET ;NO. PROCEED. + CLRB A2PF ;HE DID. STOP $$P-ING. +BPTTY4: JMP CMD +BPTRET: JMP PROCED + +BPTMP: CMP A,#NBPTS*2+2 ;AT A BREAKPOINT, IS IT THE LAST ONE + BNE BPTMP1 + CLR BPTADR-2(A) ;YES, CLR THE BREAKPOINT + CLRB A2PF ;STOP $$P'ING +BPTMP1: RTS PC + + ;FLTTYP IS THE ROUTINE WHICH PRINTS THE TYPE OF FAULT WHEN DDT IS +;ENTERED VIA A FAULT. IF THE FAULT TYPE IS UNKNOWN, THEN THE SYMBOL +;UNK IS TYPED, OTHERWISE, THE FIRST THREE LETTERS OF THE SYMBOL ARE +;GENERALLY USED. (SEE THE FAULT SYMBOL DEFINITIONS). FLTTYP EXPECTS +;ITS ARGUMENT IN B +FLTTYP: MOV #FLTTB,A ;FLTTB IS THE START OF THE FAULT SYMBOL TABLE + BIC #100000,B ;IGNORE THIS BIT +FLTTY1: TST (A) ;THE LAST ENTRY HAS A VALUE OF 0 + BEQ FLTTY2 ;FOUND THE LAST ENTRY, TYPE "UNK" AS SYMBOL + CMP B,(A) ;DOES THIS SYMBOL HAVE THE SAME VALUE AS THE ARG + BEQ FLTTY2 ;YES, TYPE THE SYMBOL FOR THIS VALUE + ADD #6,A ;OTHERWISE, CHECK THE NEXT SYMBOL + BR FLTTY1 +FLTTY2: ADD #2,A ;MAKE A POINT TO THE RAD50 SYMBOL + MOV A,SYTYAD ;SYMOUT EXPECTS ITS ARGUMENT HERE + JSR PC,SYMOUT ;TYPE THE SYMBOL + RTS PC + +;FAULT IS THE ENTRY POINT INTO DDT FOR PROCESS FAULTS. DDT IS LOCKED +;SO THAT ONLY 1 PROCESS MAY ENTER AT THE FAULT ENTRY. THE DDT FAULT +;PROCESS WHICH IS CREATED GETS THE FAULTING PROCESS READY FOR EXAMINATION +;BY DDT, DECODES THE FAULT AND BEGINS EXECUTION OF DDT. + +FAULT: MOV #DDTLOK,P + .QULK + ERRORB + MOV #PDL,P + MOV A,PRCAP ;THE INDEX OF THE PROCESS CAPABILITY CREATED + ;BY THE FAULT IS ASSUMED TO BE LEFT IN A + MOV B,SPHCAP ;THE INDEX OF THE FAULTED SPHERE CAPABILITY + ;IS ASSUMED TO BE PUT IN B + JSR PC,SAVEST ;OPEN THE PROCESS FOR EXAMINATION, IE SAVE ITS REGISTERS + JMP BPTTRP ;FOR NOW, TREAT ALL FAULTS AS BPT'S + +.SBTTL COLON COMMANDS + +;COLCMD IS THE COLON COMMAND INTERPRETER. IT FIRST READS A WORD, +;AND IF THAT WORD IS ONE OF THE INTERNAL DDT COMMANDS, THEN THAT +;COMMAND IS EXECUTED. IF NOT, THE WORD BECOMES THE DEFAULT FILE +;NAME AND AND THE FILE NOW SPECIFIED BY DEFAULT FILE NAME AND +;DEFAULT DIRECTORY IS RUN AS A PROGRAM LIKE THE CONTROL K COMMAND. +COLCMD: MOV #STRBUF,A ;WHERE TO READ IN THE NAME + MOV #SBFLEN,B ;LENGTH OF THE STRBUF + JSR PC,READWD ;READ A WORD INTO STRBUF + SAVE A ;SAVE THE NUMBER OF CHARACTERS GOTTEN + CLR C ;C WILL BE THE OFFSET INTO THE COLON COMMAND TABLES +COLCM1: MOV #STRBUF,A ;CONTAINS THE NAME + MOV CNAMTB(C),B ;GET A POINTER TO A COLON COMMAND NAME + BEQ COLCM3 ;END OF THE CNAMTB HAS A ZERO ENTRY + JSR PC,CMPSTR ;COMPARE THE READ IN NAME WITH THIS COMMAND NAME + BEQ COLCM2 ;THEY ARE THE SAME + ADD #2,C ;ADVANCE TO THE NEXT COMMAND NAME + BR COLCM1 +COLCM2: TST (P)+ ;POP OFF THE USELESS STUFF + JMP @CCMDTB(C) ;DISPATCH TO THE COMMAND WITH THIS NAME +COLCM3: REST C ;GET BACK THE COUNT OF BYTES + MOV #STRBUF,A ;POINTER TO PROGRAM COMMAND LINE FIELD + MOV #SBFLEN,B ;LENGTH OF THE COMMAND LINE FIELD + ADD C,A ;POINT TO THE END OF THE ALREADY GOTTEN COMMAND + SUB C,B ;THAT NUMBER OF BYTES LEFT IN THE BUFFER + JSR PC,READST ;READ THE REST OF THE LINE, INCLUDING CR + JSR PC,CRLF ;ECHO THE CRLF + JMP RUNPGM ;RUN THE PROGRAM SPECIFIED BY THE DEFAULT FILE + + +;RUNPGM CREATES A NEW INFERIOR SPHERE, LOADS THE FILE SPECIFIED BY THE DEFAULT +;FILE NAME INTO THAT SPHERE, CREATES A NEW PROCESS, AND STARTS THE PROCESS. +;IT DOES NOT LOAD THE SYMBOLS. +RUNPGM: MOV #STRBUF,A ;THE FILE NAME IS LOCATED HERE + JSR PC,OPEN ;OPEN UP THE FILE + ERROR ,FILCMD + JSR PC,FILCHK ;MAKE SURE ITS A FILE + JSR PC,NEWSPH ;CREATE A NEW SPHERE + ERROR ,CMD + JSR PC,INITLD ;INITIALIZE VARIABLES FOR THE LOAD + TST MAPADR ;FIRST WORD ZERO IMPLIES PURE LOAD + BNE RUNPG1 ;OTHERWISE DO ABSOLUTE LOAD + JSR PC,PPLOAD ;LOAD IN PURE FORMAT + BR RUNPG2 +RUNPG1: JSR PC,ABSPLD ;LOAD IN ABSOLUTE FORMAT +RUNPG2: DELCAP FILCAP ;DELETE THE FILE CAPABILITY + JSR PC,NEWPR ;CREATE A NEW PROCESS + JSR PC,RSTMAP ;RESET THE PAGE MAP + MOV SADDR,B ;STARTING ADDRESS IS ARG TO A1GO4 + JMP A1GO4 ;START THE PROCESS + + + +.SBTTL LOADERS + +;LOAD CREATES A SPHERE, LOADS A FILE INTO THE SPHERE, AND CREATES A PROCESS +;FOR THE SPHERE. IF THE FIRST WORD OF THE FILE IS ZERO, THEN IT IS ASSUMED TO +;BE IN PURE DUMP FORMAT. OTHERWISE, IT IS ASSUMED TO BE IN ABSOLUTE LOADER FORMAT. +;THE SYMBOLS FROM THE FILE ARE PUT IN THE SYMBOL TABLE. +LOAD: JSR PC,OPNFIL ;OPEN THE FILE SPECIFIED BY TTY + JSR PC,FILCHK ;MAKE SURE IT'S A FILE + JSR PC,NEWSPH ;CREATE A NEW SPHERE + JSR PC,INITLD ;INITIALIZE VARIABLES FOR LOADERS AND GET FIRST BLOCK + TST MAPADR ;FIRST BYTE OF FIRST BLOCK IS IN MAPADR + BNE LOAD1 ;NOT ZERO, THUS ASSUME ABSOLUTE LOADER FORMAT + JSR PC,PPLOAD ;OTHERWISE, PURE FORMAT. LOAD PROGRAM PART. + JSR PC,PSLOAD ;NOW LOAD THE SYMBOLS + BR LOAD2 +LOAD1: JSR PC,ABSPLD ;LOAD PROGRAM PART IN ABSOLUTE FORMAT + JSR PC,ABSSLD ;LOAD SYMBOL PART IN ABSOLUTE FORMAT +LOAD2: JSR PC,NEWPR ;CREATE A NEW PROCESS + JSR PC,RSTMAP ;RESTORE THE MAP + JMP FILCMD ;GET THE NEXT COMMAND + + ;INITLD INITIALIZES THE LOADER VARIABLES AND READS THE FIRST BLOCK OF THE FILE. +INITLD: CLR SYMPAG ;START AT PAGE 0 + CLR SYMBLK ;BLOCK ZERO OF PAGE 0 + JSR PC,SYMMAP ;MAP IN FIRST PAGE OF THE FILE. INIT B, BUFFER POINTER + RTS PC + +;PPLOAD LOADS THE PROGRAM PART OF A PURE FORMAT FILE. IT ASSUMES THAT THE FIRST +;BLOCK, CONTAINING THE MAP, IS IN BUFPAG, AND LEAVES SYMPAG POINTING TO THE +;FIRST PAGE OF SYMBOLS IN THE FILE +PPLOAD: CLR E ;E IS THE NUMBER OF THE PAGE WE ARE LOADING +PPLOA1: MOV MAPADR+MAPOFF(E),C ;GET A MAP WORD + MOV E,D ;GET A COPY OF THE PAGE NUMBER + ASR D + BIT #.PDEI,C ;IS THIS AN I=D PAGE? + BEQ PPLOA2 ;NO + CMP E,#20 ;IF YES, THEN ARE WE ON D PAGES YET? + BGE PPLOA3 ;YES. NO NEED TO MAP THIS PAGE. GO ON TO NEXT. + ADD #20,D ;NO. FOR I PARTS OF I=D PAGES TELL MAP ABOUT I=D +PPLOA2: BIT #.PFIL,C ;IS THIS A FILE PAGE? + BEQ PPLOA3 ;NO + INC SYMPAG ;SET POINTER TO NEXT PAGE + MOV C,F ;GET A COPY OF MAP WORD + BIC #.PLENM,F ;MAP OR BLKI THIS MANY 512 BLOCKS + BIT #.CRWRT,C ;SHOULD HE GET WRITE ACCESS? + BNE PPLOA4 ;YES + $MMAP SPHCAP,#.CRRD,FILCAP,D,SYMPAG,#0,F + BR PPLOA3 +PPLOA4: MOV #20000,A ;NUMBER OF BYTES PER PAGE + MUL SYMPAG,A ;WHERE TO SET THE POINTER + INVOK. FILCAP,#.FASP,A,B ;SET THE FILE POINTER + ERRORB + $MMAP SPHCAP,#.CRWRT,#-1,D,#0,#0,F ;FRESH PAGE + MOV E,D ;GET ANOTHER COPY OF THE PAGE NO. + ASR D + $MMAP #MYSPHR,#.CRWRT,SPHCAP,#BUFPAG,D,#0,F ;NOW MAP INTO DDT + INC F ;SINCE 0=1 + MOV F,A ;FOR THE MULTIPLY + MUL #2000,A ;THE NUMBER OF BYTES TO BLKI + NEG B ;SINCE BLKI LIKES A NEGATIVE COUNT + SAVE <#BUFADR,B,FILCAP> + $BLKI +PPLOA3: ADD #2,E ;ADVANCE TO NEXT PAGE + CMP E,#40 ;HAVE WE DONE ALL THE PAGES YET? + BLT PPLOA1 ;NO ADVANCE TO NEXT PAGE + MOV MAPADR+MSADDR,SADDR ;COPY THE STARTING ADDRESS + MOV #-1,CURPAG ;SO WE RE-MAP IN THE CORRECT PAGE + RTS PC + + ;PSLOAD LOADS THE SYMBOL PART OF A PURE FORMAT LOAD FILE. +PSLOAD: JSR PC,SYMFIX ;MAKE SURE WE'RE ON A HKWORD BOUNDRY + MMAP #MYSPHR,#.CRRD,FILCAP,#BUFPAG,#0,#0,#1 ;GET THE MAP PAGE + ERROR ,FILCMD + INVOK. FILCAP,#.FASP,BUFADR+SFILP1,BUFADR+SFILP2 + ERROR ,FILCMD + JSR PC,SYMFIX ;ADJUST SYMEND TO HKBLOCK BOUNDRY + MOV SYMEND,A + SUB BUFADR+SPARTL,A ;RESULT IS WHERE TO START LOADING SYMBOLS + CMP A,#SYMBEG ;SINCE SYMBOL TABLE STARTS AT ZERO, ONLY WAY TO + ;OVERFLOW IS TO WRAP AROUND + BHIS PSLOER +1$: CMP A,SYMBOT ;ARE WE ON AN EXISTING PAGE + BHIS 2$ ;FINE + JSR PC,PAGADD ;ADD A PAGE TO THE SYMBOL TABLE + BR 1$ ;TRY AGAIN +2$: MOV BUFADR+SPARTL,B ;GET THE LENGTH OF THE SYMBOL PART OF FILE + NEG B ;.BLKI WANTS A NEGATIVE COUNT + SAVE ;LOAD POINT,COUNT, AND FILE CAP + .BLKI ;MOVE SYMBOLS + ERROR ,PSLOER + MOV A,SYMEND ;RESET SYMEND + CLZ ;SUCCEED + RTS PC +PSLOER: SEZ ;FAIL + RTS PC + + ;SYMLOD LOADS THE SYMBOL TABLE, GROWING DOWN FORM SYMEND. IT IS ASSUMED TO BE +;CALLED WITH FILCAP CONTAINING A CAPABILITY WHICH POINTS INTO AN ABSOLUTE LOADER +;FORMAT FILE AT THE FIRST LOADER BLOCK OF THE SYMBOL TABLE. +ABSSLD: MOV #LSTSY,SYMEND ;FLUSH THE OLD SYMBOLS +SYMLOD: JSR PC,SYMFIX ;MAKE SURE WE'RE ON A RGWORD-HKWORD BOUNDRY + MOV SYMEND,SYMBAS ;THESE SYMBOLS START GROWING FROM THE END OF OLD SYM TAB + MOV SYMEND,E + SUB SYMBOT,E ;GIVES A COUNT OF THE SPACE REMAINING IN SYM AREA + TST E ;IS THE SYMBOL TABLE FULL? + BLE SYMLP ;YES, THERE IS NOTHING TO ZERO + ASR E ;CONVERT FROM BYTE COUNT TO WORD COUNT + MOV SYMBOT,A ;START CLEARING FROM BOTTOM OF SYMBOL AREA + CLR (A)+ ;NOTE THAT SYMBOLS ARE ASSUMED ON WORD BOUNDRIES + SOB E,.-2 ;ZERO THE FREE SPACE IN SYMBOL AREA +SYMLP: CLR E ;ZERO THE CHECKSUM + JSR PC,SYMBYT ;GET A BYTE FROM THE MAP BUFFER INTO A + CMPB A,#1 ;ABSOLUTE LOADER FORMAT STARTS BLOCKS WITH 1 THEN 0 + BNE SYMLP ;KEEP READING UNTIL WE GET A 1 OR AN EOF FAULT + JSR PC,SYMBYT ;GET ANOTHER BYTE + TSTB A ;THIS TIME WE ARE CHECKING FOR A ZERO + BNE SYMLP ;AGAIN, LOOP UNTIL WE FIND A 1 0 HEADERî + JSR PC,SYMWRD ;GET A WORD FROM THE MAP BUFFER + MOV A,D ;THIS WORD WILL BE THE COUNT OF THE LOADER BLOCK + JSR PC,SYMWRD ;GET ANOTHER WORD, LEAVE IT IN A + MOV A,C ;FOR SYMBOL, THIS IS A NEGATIVE OFFSET FOR LOAD ADDRî + SUB #6,D ;A COUNT OF 6 MEANS THIS IS FINAL BLOCK + BEQ SYMFIN ;YES THIS WAS FINAL BLOCK + ADD SYMBAS,C ;ADJUST THE POINTER TO THE TRUE CORE LOCATIONî + SUB #RUGNUM,C ;RUG OFFSET KLUDGE + CMP C,#SYMBEG ;CHECK THAT THIS POINTER DOES NOT OVFL SYM TAB SPACE + BHIS SYMOVF ;YES - DO NOT ADD ANY MORE SYMBOLS + CMP C,SYMEND ;IS THIS THE LOWEST POINT FOUND SO FAR + BHIS SYMLD1 ;NO + MOV C,A ;GET A COPY OF THE STARTING ADDRESS + BIT #1,A ;ARE WE ON A WORD BOUNDRY? + BEQ .+4 ;YES, THIS VALUE OK FOR SYMEND + DEC A ;OTHERWISE GO DOWN TO WORD BOUNDRY +1$: CMP A,SYMBOT ;ON AN EXISTING PAGE? + BHIS 2$ ;YES + JSR PC,PAGADD ;ADD A PAGE + BR 1$ +2$: MOV A,SYMEND ;MAKE THIS LOC THE NEW END OF SYM TAB +SYMLD1: JSR PC,SYMMOV ;MOV THIS LOADER BLOCK, USING C AS POINTER, D AS COUNT + JSR PC,SYMBYT ;GET THE CHECKSUM, ADDING IT TO CHECKSUM WE ACCUMULATED + TSTB E ;THE RESULT SHOULD BE ZERO, ELSE CHECKSUM ERROR + BEQ SYMLP ;CHECKSUM OK, CONTIUE GETTING LOADER BLOCKS + JSR PC,SYMCHK ;CHECKSUM LOSSAGE + BR SYMLP ;NO NEED TO STOP, ALTHOUGH SYMBOLS MAY BE MUNGED + +SYMCHK: TYPEIT + RTS PC + +SYMOVF: TYPEIT + RTS PC ;STOP - DO NOT LOAD ANY MORE SYMBOLS + +SYMFIN: JSR PC,SYMBYT ;GET THE CHECKSUM + TSTB E ;CHECK THAT IT ZEROS PROPERLY + BEQ .+6 ;CKECKSUM OK + JSR PC,SYMCHK ;OTHERWISE, INFORM USER OF LOSSAGE + RTS PC + +;SYMBYT GETS 1 BYTE FROM MAP BUFFER, ADDS IT TO CHECKSUM, AND RETURNS IT IN A +SYMBYT: CMP #MAPADR+BLKL,B ;ARE WE AT THE END OF THE BUFFER? + BGT .+6 ;NOT YET + JSR PC,SYMMAP ;OTHEWISE MAP IN A NEW BLOCK FROM THE FILE + MOVB (B)+,A + ADD A,E ;ADD INTO CHECKSUM + RTS PC + +;SYMWRD ACTS LIKE SYMBYT, BUT GETS A WORD INTO A +SYMWRD: JSR PC,SYMBYT ;GET A BYTE, THE LOW BYTE OF THE WORD + SAVE A ;HACK TO MERGE THE BYTES + JSR PC,SYMBYT ;GET THE HIGH BYTE + MOVB A,1(P) ;A KLUDGE, BUT IT DOESN'T USE ANY REGISTERS + REST A + RTS PC + + ;SYMMOV MOVES A BLOCK OF BYTES FROM THE MAP BUFFER TO LOCATIONS IN CORE. B POINTS +;TO THE NEXT AVAILABLE BYTE IN THE MAP BUFFER, C SAYS WHERE TO START MOVING THE +;BYTES, AND D IS A COUNT OF THE BYTES TO MOVE. +SYMMOV: MOV #BLKL+MAPADR,A ;BLKL IS THE NEXT BYTE AFTER THE END OF MAP BUFFER + SUB B,A ;THIS GIVES THE NUMBER OF BYTES LEFT IN BUFFER + CMP A,D ;ARE ALL THE BYTES IN THIS LOADER BLOCK IN THE BUFFER? + BGE SYMMO1 ;YES, SO JUST MOV THEM DIRECTLY FROM THE BUFFER + SUB A,D ;TAKE THE NUMBER OF BYTES IN BUFFER FROM THE LOADER BLK + SAVE D ;THE RESULT IS THE NUMBER OF BYTES LEFT IN LOADER BLOCK + MOV A,D ;WE CAN TAKE THIS MANY BYTES FROM THE BUFFER + BEQ 1$ ;NONE, GET NEXT PAGE + JSR PC,SYMMO1 ;MOVE ALL THE BYTES LEFT IN THE BUFFER +1$: JSR PC,SYMMAP ;NOW MAP IN A NEW BUFFER + REST D ;RESTORE THE COUNT OF BYTES LEFT IN LOADER BLOCK + BR SYMMOV ;NOW TRY TO GET THE REST OF THE LOADER BLOCK + +SYMMO1: MOVB (B)+,A ;GET THE NEXT BYTE FROM BUFFER + ADD A,E ;ACCUMULATE CHECKSUM + MOVB A,(C)+ ;PUT THE BYTE INTO MEMORY AT C LOCATION + SOB D,SYMMO1 ;CONTINUE MOVING UNTIL D RUNS OUT + RTS PC + +;SYMMAP MAPS THE NEXT BLOCK OF THE FILE INTO THE BUFFER PAGE, AND RESETS THE +;BUFFER POINTER, B, TO THE BEGINNING OF THE BUFFER. SYMBLK CONTAINS THE NEXT +;AVAILABLE BLOCK ON THIS PAGE, AND SYMPAG SAYS WHAT PAGE THAT IS. EVERY 8 BLOCKS +;THE PAGE IS INCREMENTED. +SYMMAP: MOV SYMBLK,-(P) ;OFFSET IS THE NUMBER OF THE BLOCK WE WANT + ;THIS ASSUMES TOP OF SYMBLK IS 0 FOR LENGTH OF 1 + MOV SYMPAG,-(P) ;WE WANT THIS PAGE OF THE FILE + MOV FILCAP,-(P) ;C-LIST INDEX OF THE FILE CAPABILITY + BIS #MAPPAG*400,(P) ;MAP INTO DDT'S GENERAL MAPPPING PAGE + MOV #.CRWRT+MYSPHR,-(P);MAP THE PAGE INTO MY SPHERE (MY SPHERE CAP IS MYSPHR) + .MAP + ERROR ,ABLDFM + INC SYMBLK ;ADVANCE TO NEXT BLOCK + CMPB SYMBLK,#10 ;THERE ARE 8 BLOCKS TO A PAGE + BLT SYMMA1 ;WE HAVE NOT YET OVERFLOWED THE PAGE + CLRB SYMBLK ;GO BACK TO BLOCK 0 + INC SYMPAG ;ADVANCE TO NEXT PAGE +SYMMA1: MOV #MAPADR,B ;RESET THE BUFFER POINTER TO START OF BUFFER + MOVB #-1,CURPAG ;CURPAG IS NOW INVALID + RTS PC + +;ADDA PAGE TO THE SYMBOL TABLE +PAGADD: SAVE A + MOV SYMBOT,A ;POINTER TO THE LOWEST EXISTING LOCATION + BNE 1$ ;FINE, CAN GO LOWER + BPT +1$: ASH #-13.,A ;SHIFT TO A BLOCK NUMBER + BIC #177770,A ;MASK IT TO A BLOCK NUMBER + BIS #10,A ;JUST MAKE D PAGES + DEC A ;NOW THE PAGE BEFORE THIS ONE + $MMAP #MYSPHR,#.CRWRT,#-1,A,#0,#0,#7 ;NOW MAP INTO DDT A PAGE + SUB #20000,SYMBOT ;SYMBOT IS NOW LOWER + REST A + RTS PC + +;TSTCCP CHECKS TO SEE IF WE HAVE A CAPABILITY IN THE SLOT BEFORE +;TRYING TO GIVE IT AWAY. EXPECT THE CAP NUMBER IN A. +TSTCCP: INVOK. #MYSPHR,#400,A ;CHECK IF I HAVE A CAPABILITY HERE + ERROR ,TSTCC2,3 + REST B ;RETURN 0 IF NO CAPABILITY + BEQ TSTCC1 ;NOTHING THERE + JSR PC,COPCPS ;ELSE COPY FROM ME TO HIM + ERROR ,TSTCC2 +TSTCC1: RTS PC +TSTCC2: SAVE A ;OTYPE CLOBBERS THIS + MOV A,B ;OTYPE WANTS ARG IN B + JSR PC,OTYPE ;TYPE AS OCTAL NUMBER + REST A ;CLEAN UP + RTS PC + +;COPY CAPABILITY FROM US INTO HIM +;CAPABILITY TO COPY IN A, PLACE TO COPY TO IN B +COPCPS: MOV A,B ;SPECIAL, COPY INTO SAME PLACE +COPCP: SAVE <#-1,#0,A> ;MAKE A COPY OF THE ONE WE WANT TO GIVE AWAY + BIS #.CPYCP,(P) + .INVOK + BEQ COPCE1 ;LOSE, CAN'T COPY IT + REST TMPCAP ;SO WE CAN DELETE IT IF WE LOSE + SAVE ;GIVE IT AWAY + BIS #.GIVCP,(P) + .INVOK + BEQ COPCER ;CAN'T GET RID OF IT! + TST (P)+ ;CAPABILITY TO IT + CLR TMPCAP + CLZ ;SUCCESSFUL ! + RTS PC +COPCER: DELCAP TMPCAP +COPCE1: ADD #6,P ;FLUSH THE ARGUMENTS TO INVOK + SEZ + RTS PC + +;DELETE THE CAPABILITY GIVEN IN A UNLESS IT IS ZERO +DELCP: TST A ;IS THERE A CAP TO FLUSH? + BLE DELCP1 ;NOPE + CMP -(P),-(P) + SAVE A ;THE CAPABILITY + BIS #.DELCP,(P) ;THE DELETE FUNCTION + .INVOK + ERROR ,CMD +DELCP1: RTS PC + +;RSTMAP RESETS THE MAP OF THE INFERIOR SPHERE. IF NO SPHERE IS LOADED, +;THE MAP IS ZEROED, INDICATING NO PAGES AVAILABLE. +RSTMAP: MOV #-1,CURPAG ;GARBAGE CURPAGE TO MAKE SURE WE MAP IN A NEW ONE + TST SPHCAP ;IS ANY SPHERE LOADED? + BEQ RSTMER ;NO, ZERO THE MAP + SAVE <#SPHMAP,SPHCAP> + .RDMAP ;READ THE MAP + ERROR ,RSTMER + CLZ + RTS PC +RSTMER: SAVE ;GET SOME REGISTERS + MOV #SPHMAP,A + MOV #16.,B +RSTME1: CLR (A)+ + SOB B,RSTME1 ;ZERO THE MAP TO ELIMINATE ALL ACCESS + REST + SEZ + RTS PC + + ;CLOAD CREATES A NEW SPHERE AND NEW PROCESS, BUT DOES NOT LOAD A +;PROGRAM INTO THE SPHERE. +CLOAD: JSR PC,NEWSPH ;CREATE A NEW SPHERE + ERROR ,CMD2 + JSR PC,NEWPR ;CREATE A NEW PROCESS + ERROR + JMP CMD2 + +;NEWSPH CREATES A NEW INFERIOR SPHERE, AND GIVES IT THE APPROPRIATE +;INITIAL CAPABILITIES. +NEWSPH: MOV #LSTSY,SYMEND ;FLUSH ALL THE SYMBOLS + MOV #1,SADDR ;FLUSH THE STARTING ADDRESS + JSR PC,BPTFLS ;FLUSH ALL THE BREAKPOINTS + DELCAP SPHCAP ;GET RID OF THE OLD SPHERE + JSR PC,RSTMAP ;ZERO THE MAP (SINCE SPHCAP IS ZERO) + INVOK. #CRCAP,#.MSCAP*400,#FAULT,#-1 + ERROR ,NEWSP1,3 + REST SPHCAP ;THIS SPHERE NOW BECOMES THE CURRENT SPHERE + MOV #0,A ;CREATE CAPABILITY + JSR PC,TSTCCP ;COPY IT + MOV SPHCAP,A ;HIS SPHERE CAP + MOV #1,B + JSR PC,COPCP ;COPY SPHCAP INTO HIS CAPABLILITY 1 + ERROR ,NEWSP1 + MOV #2,A ;COPY ALL THE CAPABILITIES I HAVE UP TO 20 +NEWSP2: JSR PC,TSTCCP + INC A ;NEXT ONE + CMP A,#20 ;ARE WE DONE YET? + BLT NEWSP2 ;NO + CLZ ;SUCCEED + RTS PC +NEWSP1: SEZ + RTS PC + +;NEWPR CREATES A NEW PROCESS AND PUTS IT INTO THE CURRENT SPHERE. +;THE PROCESS INITIALLY HAS ZERO IN ALL REGISTERS EXCEPT PC WHICH HAS SADDR. +NEWPR: DELCAP PRCAP ;FLUSH THE OLD PROCESS + MOV #UA,A ;SET POINTER TO FIRST REGISTER +NEWPR1: CLR (A)+ + CMP A,#PRSYMS ;HAVE WE ZEROED ALL THE REGISTERS YET? + BLOS NEWPR1 ;NO, KEEP ZEROING UNITL WE HAVE + INVOK. #CRCAP,#.PRCAP*400,SADDR,#-1 ;CREATE A PROCESS + ERROR ,NEWPER + REST PRCAP ;MAKE THIS PROCESS THE CURRENT PROCESS + INVOK. SPHCAP,#0,PRCAP ;PUT THE PROCESS INTO THE CURRENT SPHERE + ERROR ,NEWPER + CLZ ;SUCCEED + RTS PC +NEWPER: ADD #6,P ;POP THE ARGUMENTS TO INVOKE + SEZ + RTS PC + + ;ABSOLUTE LOADER +ABSPLD: +ABSLOD: MOV #10,C ;FOR ALL 8. PAGES IN THE SHPERE (I=D) + MOV #LODSMP,D ;CLEAR OUT THE MAP BYTES + CLR USREND ;THIS WILL BE UPDATED AS WE LOAD +ABSLO1: MOVB #-1,(D)+ + SOB C,ABSLO1 + MOV #-1,LODPA + ;E IS CHECKSUM + ;C IS CORE ADDRESS + ;D IS BYTE COUNT +ABSLOP: CLR E + JSR PC,SYMBYT + CMPB #1,A ;IS IT THE START OF A BLOCK? + BNE ABSLOP ;NO, TRY AGAIN + JSR PC,SYMBYT + TST A + BNE ABSLOP ;SHOULD BE A ZERO NEXT + JSR PC,SYMWRD ;GET THE COUNT + MOV A,D ;SAVE IT + JSR PC,SYMWRD ;GET THE ADDRESS + MOV A,C + SUB #6,D ;IS IT THE START BLOCK? + BEQ ABSSRT ;YUP +ABSLP1: JSR PC,SYMBYT + MOV C,F ;CHECK THAT THIS PAGE IS MAPPED IN + ASH #-13.,F ;CONVERT TO PAGE # + BIC #177770,F ;CAUSE THERE IS NO LSH + TSTB LODSMP(F) ;IS IT EXTANT? + BGE ABSLP2 ;YES + SAVE <#<7*400+0>,#0,#-1,SPHCAP> + BIS #.CRWRT,(P) ;GIVE CORE WRITE CAPABILITY + MOVB F,3(P) + BISB #20,3(P) + .MAP ;WHEW! GET THE NEW PAGE! + BEQ ABLDFL ;THE LOAD FAILS CAUSE WE DON'T GET THE PAGE + MOVB #7,LODSMP(F) + JSR PC,PAGLOD ;PUT THE NEW PAGE INTO OUR MAP + MOV #BUFADR,F +ABSLP3: CLR (F)+ ;ZERO THE PAGE + CMP F,#BUFADR+20000 ;ARE WE OFF THE END OF THE PAGE YET? + BLT ABSLP3 ;KEEP ZEROING UNTIL WE ARE + BR ABSLP2+4 ;DON'T DO ANOTHER PAGLOD,F IS MUNGED + +;NOW HERW WE CHECK THAT THE PAGE MAPPED IN IS THE ONE WE +;ARE ABOUT TO REFERENCE, AND FIX IT IF IT ISN'T! +ABSLP2: JSR PC,PAGLOD ;PUT THE PAGE INTO OUR MAP IF NEEDED + MOV C,F + BIC #160000,F ;MUST RELOCATE ADDRESS + ADD #BUFADR,F ;MAKE SURE WE'RE IN PAGE 1 + MOVB A,(F) + INC C + SOB D,ABSLP1 + CMP C,USREND ;IS THIS THE HIGHEST YET? + BLO .+6 ;NO + MOV C,USREND ;YES, UPDATE THE END OF HIS CORE + JSR PC,SYMBYT ;THE CHECKSUM + TSTB E + BEQ ABSLOP ;CHECKSUM GOOD + BR ABLDBC +ABSSRT: JSR PC,SYMBYT ;GET CHECKSUM + TSTB E + BNE ABLDBC ;BAD CHECKSUM, INFORM USER + MOV C,SADDR ;THE ADDRESS IS START ADDR OF PROGRAM + RTS PC + +PAGLOD: CMP F,LODPA ;IS THAT THE CURRENTLY MAPED IN PAGE? + BEQ PAGLO1 ;YES, YOU WIN + MOV F,LODPA ;WILL BE + SAVE <#<7*400>+0,F,SPHCAP,#.CRWRT+1> ;TO MAP INTO OURSELF + MOVB #BUFPAG,3(P) ;INTO I=D PAGE 1 + .MAP + BEQ ABLDMF +PAGLO1: RTS PC + +ABLDBC: TYPEIT + BR ABLDFM ;BAD CHECKSUM +ABLDFL: TYPEIT + BR ABLDFM ;NO CORE +ABLDMF: TYPEIT ;.MAP FAILED +ABLDFM: DELCAP FILCAP ;DELETE THE FACAP + DELCAP SPHCAP ;DELETE THE SPHERE + DELCAP PRCAP ;DELETE THE PROCESS + DELCAP TMPCAP ;DELETE THE TMPCAP USED BY COPCP + JMP CMD ;GET A NEW COMMAND + + +;BINLOD LOADS A FILE DIRECTLY INTO AN INFERIOR SPHERE WITHOUT MAKING +;ANY INTERPRETATION OF THE BINARY DATA. IT JUST MAPS PAGES OF THE +;FILE INTO THE SAME PAGE IN THE SPHERE, AND MAPS AS MUCH OF THE FILE +;AS WILL FIT INTO I=D SPACE IN THE SPHERE. +BINLOD: JSR PC,OPNFIL ;READ A FILENAME AND GET CAPABILIY TO THAT FILE + JSR PC,NEWSPH ;CREATE A NEW INFERIOR SPHERE + ERROR ,FILCMD + INVOK. FILCAP,#.FARE ;READ THE LENGTH OF THE FILE + ERROR ,FILCMD + REST ;RETURN THE 32 BIT LENGTH + DIV #20000,A ;SEPARATE INTO NUMBER OF PAGES AND REMAINDER + TST B ;IS THERE ANYTHING BEYOND FULL PAGES? + BEQ BINLO1 ;NO + INC A ;INCREMENT THE PAGE COUNT FOR ANY LEFTOVER BLOCKS +BINLO1: MOV #20,C ;C WILL BE THE PAGE IN SPHERE TO MAP INTO + CLR D ;D WILL BE THE FILE PAGE NUMBER +BINLO2: MMAP SPHCAP,#.CRWRT,FILCAP,C,D,#0,#-1 + ERROR ,FILCMD + INC C ;INCREMENT THE SPHERE PAGE NUMBER + INC D ;INCREMENT THE FILE PAGE NUMBER + CMP D,#10 ;ONLY 8 PAGES ARE AVAILABLE IN A SPHERE + BGE BINLO3 ;IGNORE THE REST OF THE FILE + SOB A,BINLO2 ;LOOP UNTIL THE COUNT OF PAGES IN FILE RUNS OUT +BINLO3: JSR PC,RSTMAP ;RESET THE MAP + JMP FILCMD ;DONE, DELETE THE FILCAP + +.SBTTL DUMPERS + +;PDUMP DUMPS A SPHERE AND SYMBOL TABLE IN PURE FORMAT. +PDUMP: JSR PC,CRFIL ;GET A CAPABILITY TO A NEW FILE + JSR PC,NEWBUF ;MAP IN A FRESH PAGE INTO BUFPAG + SAVE <#BUFADR,#-20000,FILCAP> + .BLKO ;LEAVE SPACE FOR THE MAP PAGE + ERROR ,FILCMD + MMAP #MYSPHR,#.CRWRT,FILCAP,#BUFPAG,#0,#0,#0 + ERROR ,FILCMD + MOV #-1,CURPAG ;SO WE MAP IN A NEW PAGE WHEN EXAMINING THINGS + MOV #BUFADR,D + CLR (D)+ ;WRITE A ZERO FOR THE FIRST WORD OF FILE + CLR B +PDUMP1: MOV SPHMAP(B),C ;GET A MAP WORD + MOV C,A ;COPY THE MAP WORD + BIC #.PACCM,A ;IS THERE ANYTHING IN THE ACCESS BITS ON THIS PAGE? + BEQ PDUMP3 ;NO, DON'T WRITE THIS PAGE + BIT #.PABS,C ;IS IT AN ABSOLUTE PAGE? + BNE PDUMP3 ;YES, DON'T DUMP ABSOLUTE PAGES + BIS #.PFIL,C ;FROM NOW ON, THIS PAGE WILL BE PART OF FILE + MOV C,(D)+ ;WRITE THE MAP WORD INTO THE FILE'S MAP PAGE + BIT #.PDEI,C ;IS THIS AN I=D PAGE? + BEQ PDUMP2 ;NO, GO AHEAD AND DUMP THE PAGE + CMP B,#20 ;IF YES, THEN ARE WE DOING D PAGES? + BGE PDUMP4 ;YES. DON'T DUMP D PARTS OF I=D PAGES +PDUMP2: MOV B,A ;GET A COPY OF THE PAGE MAP OFFSET + ASR A ;SINCE B IS A WORD OFFSET + BIC #.PLENM,C ;ISOLATE THE LENGTH + MMAP #MYSPHR,#.CRRD,SPHCAP,#MAPPAG,A,#0,C + ERROR ,FILCMD + MOV C,E ;COPY OF LENGTH + INC E ;SINCE 0=1 + MUL #2000,E ;GET THE LENGTH + NEG F ;SINCE BLKO LIKES NEGATIVE COUNT + SAVE <#MAPADR,F,FILCAP> ;POINTER TO MAPPAG, BYTE COUNT AND FILE CAP + .BLKO ;DUMP THE PAGE + ERROR ,FILCMD + ADD #20000,F ;WE MUST DUMP FULL 4K PAGES + BEQ PDUMP4 ;IF THIS WAS 4K PAGE, THEN WE ARE DONE + NEG F ;GET A COUNT OF THE REMAINING SPACE + MMAP #MYSPHR,#.CRRD,#-1,#MAPPAG,#0,#0,#7 + ERROR ,FILCMD + SAVE <#MAPADR,F,FILCAP> + .BLKO ;FILL UP THE REST OF THE PAGE + ERROR ,FILCMD + BR PDUMP4 ;ADVANCE TO NEXT PAGE +PDUMP3: CLR (D)+ ;SIMPLY WRITE A ZERO INTO FILE MAP FOR THIS PAGE +PDUMP4: ADD #2,B ;ADVANCE TO NEXT PAGE + CMP B,#40 ;ARE WE FINISHED YET? + BGE .+6 ;YES + JMP PDUMP1 ;ELSE GET NEXT PAGE + MOV SADDR,(D)+ ;NEXT OUTPUT STARTING ADDRESS + MOV #LSTSY,A ;ADDRESS OF FIRST SYMBOL IN PERMANENT TABLE + SUB SYMEND,A ;A NOW CONTAINS BYTE COUNT OF SYMBOLS + MOV A,(D)+ ;PUT BYTE COUNT IN FILE'S MAP PAGE + INVOK. FILCAP,#.FARP + ERROR ,FILCMD + REST + MMAP #MYSPHR,#0,#-3,#BUFPAG,#0,#0,#0 ;DELETE THIS PAGE + ERROR + NEG A ;FOR A NEGATIVE COUNT + SAVE + .BLKO ;DUMP THE SYMBOLS + ERROR ,FILCMD + JMP FILCMD + + PUNCH: SAVE <#-1,,#.TPCAP*400+0> + .INVOK + ERROR ,CMD + REST FILCAP + MOV TAPLEN,TAPLEF + JSR PC,TAPLED ;PUNCH A LEADER + JMP HAXPUN + + + + +;A1YANK DUMPS A CORE IMAGE FILE OF THE SPHERE BEING DEBUGGED. THIS FILE IS IN +;ABSOLUTE LOADER FORMAT, SUITABLE FOR BEING LOADED VIA THE ALT L COMMAND. ABSOLUTE +;LOADER FORMAT CONSISTS OF A SERIES OF LOADER BLOCKS (DESCRIBED IN YFILE), A NULL +;BLOCK WHICH GIVES THE STARTING ADDRESS, THE BLOCKS CONTAINING THE SYMBOL, AND +;FINALLY ANOTHER NULL BLOCK. + +;REGISTER ASSIGNMENTS: +; A,B WORKING REGISTERS +; C SOURCE POINTER +; D COUNT OF BYTES LEFT IN SOURCE PAGE +; E POINTER TO NEXT AVAILABLE LOCATION IN BUFFER + +A1YANK: JSR PC,CRFIL ;CREATE A FILE IN THE DIRECTORY + ERROR ,FILCMD + MOV #-1,TAPLEF ;INFINITE TAPE LEFT IF NOT PUNCHING +HAXPUN: SAVE <#7*400,#0,#BUFPAG*400,#.CRWRT+1> + MOVB #-1,2(P) ;MAKE A FRESH PAGE IN THE BUFFER PAGE (1) + .MAP + ERROR ,CMD + MOV #BUFADR,E ;SET THE POINTER TO BEGINNING OF BUFFER + CLR SPAG ;START READING FROM SOURCE PAGE 0 + CLR D ;MAKE SURE WE MAP IN THE FIRST PAGE + CLR SYMFLG ;READ PROGRAM, NOT SYMBOLS (MAP THE PAGES) + JSR PC,YFILE1 ;YANK THE PROGRAM PART OF THE FILE + TST TAPLEF ;IF TAPLEF < 0, PUNCHING TAPE, NO SYMBOLS + BGE A1YAN4 + INC SYMFLG ;SOURCE IS SYMBOLS + MOV SYMEND,C ;THIS TIME THE SOURCE ADDRESS IS BOTTOM OF SYMBOLS + MOV #LSTSY,D + SUB SYMEND,D ;THE NUMBER OF BYTES TO YANK IS #LSTSY-SYMEND + BNE A1YAN3 ;MAKE SURE THERE IS SOMETHING TO DUMP + JSR PC,YFILE1 ;THIS WILL SIMPLY DUMP THE FINAL BLOCK + BR A1YAN4 +A1YAN3: JSR PC,YFILE ;NOW YANK THE SYMBOLS PART OF THE FILE +A1YAN4: JSR PC,FLUSHB ;OUTPUT ANYTHING LEFT IN THE BUFFER + CMP -(P),-(P) ;PUSH TWO DUMMY ARGUMENTS + DELCAP FILCAP ;DELETE THE FILCAP, WE NO LONGER NEED IT + JMP CMD + + ;YFILE MOVES BYTES FROM A SOURCE AREA INTO A BUFFER. THE CONTENTS +;OF THE BUFFER IS FORMATTED INTO ABSOLUTE LOADER FORMAT. WHEN THE BUFFER FILLS, +;IT IS DUMPED OUT TO THE DISK INTO THE FILE SPECIFIED BY FILCAP. ABSOLUTE LOADER +;FORMAT CONSITS OF A HEADER (DESCRIBED IN BEGBLK), THE DATA BYTES, THEN A CHECKSUM. +;GROUPS OF 6 OR MORE ZERO BYTES CAUSE A NEW LOADER BLOCK TO BE CREATED SO THAT +;THERE ARE NOT LARGE BLOCKS OF ZEROS IN THE FILE. THE LOADER BLOCKS ARE OF ARBITRARY +;LENGTH, BUT ALWAYS CONTAIN AT LEAST 1 DATA BYTE, EXCEPT FOR THE FINAL BLOCKS. FINAL +;BLOCKS ARE BLOCKS WHICH CONTAIN NO DATA AND SERVE TO SEPARATE THE PROGRAM FROM +;THE SYMBOLS AND DELIMIT THE END OF THE SYMBOLS. THE ADDRESS OF A FINAL BLOCK IS +;THE STARTING ADDRESS OF THE PROGRAM. THERE MAY BE ZEROS BETWEEN LOADER BLOCKS IN +;THE FILE, AND THESE SHOULD BE IGNORED. IN THIS PROGRAM, THEY ARE CAUSED BY THE +;FACT THAT LOADER BLOCKS DO NOT CROSS BUFFER BOUNDRIES. + +YFILE: MOVB (C)+,A ;GET A BYTE FROM THE SOURCE + BNE YFILE2 ;IT WAS NOT A ZERO + SOB D,YFILE ;SKIP ZEROS, LOOP UNTIL NO BYTES LEFT ON PAGE +YFILE1: JSR PC,NEWPAG ;MAP IN THE NEXT PAGE, FAIL IF THIS WAS PAGE 7 + BNE YFILE ;IT WAS NOT PAGE 7. SKIP ANY LEADING ZEROS IN PAGE + TST SYMFLG ;LOADING SYMBOLS? + BNE 1$ ;YES + MOV SADDR,C ;NOW INSERT A FINAL BLOCK, ADDRESS IS SADDR + ADD #MAPADR,C ;THIS WILL BE SUBTRACTED LATER + BR 2$ +1$: MOV SYMEND,C ;THE BEGINNING OF SYMBOL TABLE +2$: MOV #1,SPAG ;HACK! BEGBLK DECS SPAG THEN BIS'S + ;IT INTO THE ADDRESS SO WE WANT IT TO BIS 0 + JSR PC,BEGBLK ;PUT IN THE BLOCK HEADER + JSR PC,ENDBLK ;COMPLETE THE BLOCK WITH NO DATA BYTES + RTS PC +YFILE2: DEC C ;BACK UP THE SOURCE POINTER + JSR PC,BEGBLK ;CREATE A NEW BLOCK, USE SOURCE POINTER AS ADDRESS +YFILE3: MOVB (C)+,A ;GET A BYTE FROM SOURCE + BEQ YFILE5 ;MAKE SURE IT WAS NOT A ZERO +YFILE4: JSR PC,PUTBYT ;PUT THE BYTE INTO THE BUFFER + SOB D,YFILE3 ;KEEP MOVING BYTES UNTIL NONE LEFT ON PAGE + JSR PC,ENDBLK ;THEN END THIS BLOCK + BR YFILE1 ;TRY TO GET THE NEXT PAGE +YFILE5: CMP D,#6 ;CHECK FOR STRING OF 6 ZEROS, ARE 6 BYTES LEFT IN PAGE? + BLT YFILE4 ;NO, JUST INSERT THE ZERO + MOV C,A ;GET A COPY OF THE SOURCE POINTER + MOV #5,B ;INITIALIZE THE COUNT +YFILE6: TSTB (A)+ ;CHECK FOR ZERO + BNE YFILE7 ;CONTINUE AS BEFORE IF WE HIT A NONZERO + SOB B,YFILE6 ;CHECK FOR 6 ZEROS IN A ROW + DEC C ;WE FOUND 6 ZEROS, BACK THE POITNER UP TO FIRST ZERO + JSR PC,ENDBLK ;FINISH OFF THE CURRENT BLOCK + BR YFILE ;SKIP ZEROS BEFORE STARTING A NEW BLOCK +YFILE7: CLR A ;MAKE SURE WE OUTPUT A ZERO + BR YFILE4 ;OUTPUT THE ZERO + + ;BEGBLK WRITES THE HEADER OF AN ABSOLUTE LOADER BLOCK INTO THE BUFFER. THIS HEADER +;CONSISTS OF A BYTE CONTAINING A 1, FOLLOWED BY A BYTE CONTAINING 0, FOLLOWED BY +;A TWO BYTE COUNT OF THE BYTES IN THE LOADER BLOCK, WHICH IS ALWAYS AT LEAST 6 FOR +;IT INCLUDES THE BYTES IN THE HEADER, BUT DOES NOT INCLUDE THE CHECKSUM. IF THE +;BLOCK CONTAINS PROGRAM, THEN THE NEXT WORD IS THE STARTING ADDRESS OF WHERE TO +;LOAD THIS DATA INTO I SPACE. IF THE BLOCK CONTAINS SYMBOLS, THEN THIS ADDRESS +;IS THE NEGATIVE OFFSET FROM THE TOP OF THE SYMBOL TABLE, PLUS A CONSTANT, THE RUG +;NUMBER=120000. BEGBLK CHECKS TO MAKE SURE THAT AN ENTIRE LOADER BLOCK WILL FIT +;INTO THE BUFFER INCLUDING THE HEADER, AT LEAST ONE DATA BYTE AND THE CHECKSUM. +;IF THIS WILL NOT FIT, THEN BEGBLK ZEROS ANY REMAINING SPACE IN THE BUFFER, WRITES +;THE BUFFER OUT INTO THE FILE AND BEGINS A NEW BUFFER. + +BEGBLK: MOV #BUFADR+BLEN,A ;PUT THE ADDRESS OF THE END OF THE BUFFER IN A + SUB E,A ;COMPUTE THE NUMBER OF BYTES LEFT IN THE BUFFER + BEQ BEGBL1 ;NO SPACE LEFT, WE MUST GET A NEW BUFFER + CMP A,#10 ;WILL A WHOLE LOADER BLOCK FIT IN THE SPACE LEFT? + BHIS BEGBL2 ;YES, GO AHEAD AN PUT THE HEADER IN THIS BUFFER + CLRB (E)+ ;NO, ZERO THE SPACE LEFT IN THE BUFFER + SOB A,.-2 +BEGBL1:; JSR PC,ENDBLK + JSR PC,FLUSHB ;WRITE THIS BUFFER OUT, AND RESET THE POINTER + JSR PC,TAPSPA ;LEAVE SOME BLANK TAPE IF THIS IS BEING PUNCHED +BEGBL2: TST TAPLEF + BLT 1$ + ADD #10,TAPLEF ;TO AVOID LOSSAGE +1$: CLR CHKSUM ;A NEW BLOCK BEGINS WITH A ZERO CHECKSUM + CLR BCNT ;THIS IS A COUNT OF THE BYTES IN THE BLOCK + MOV #1,A ;WRITE THE 1 BYTE AND 0 BYTE OF THE HEADER + JSR PC,PUTWRD ;PUT INTO THE BUFFER + MOV E,CNTPTR ;PUT OUR FINGER HERE SO WE CAN FIX WHEN WE FINISH + CLR A ;START WITH ZERO COUNT SO WE DON'T SCREW THE CHECKSUM + JSR PC,PUTWRD ;ENDBLK WILL FILL IN THE ACTUAL COUNT + MOV C,A ;GET A COPY OF THE SOURCE POINTER + TSTB SYMFLG ;ARE WE DOING SYMBOL BLOCKS? + BEQ BEGBL3 ;NO, THEN WE ARE DOING PROGRAM BLOCKS + SUB #LSTSY,A ;LSTSY IS THE START OF THE PERMANENT SYMBOLS + ADD #RUGNUM,A ;RUG'S MAGIC CONSTANT KLUDGE + BR BEGBL4 ;WRITE THE RESULT INTO THE HEADER +BEGBL3: SUB #MAPADR,A ;UNRELOCATE THE ADDRESS + MOV SPAG,B ;SPAG CONTAINS THE PAGE IN SOURCE (PROGRAM DATA ONLY) + DEC B ;NEWPAGE LEAVES THIS INCREMENTED + ASH #5,B ;PUT THE PAGE NUMBER INTO THE RIGHT PLACE + SWAB B ;BITS 0-2 GO INTO 13-15 + BIS B,A ;UNMAP THE SOURCE POINTER +BEGBL4: JSR PC,PUTWRD ;PUT THE LOAD ADDRESS INTO THE HEADER + RTS PC + +;ENDBLK FILLS IN THE CHECKSUM AND COUNT OF THE BYTES IN THE BLOCK. TO USE THE +;CHECKSUM ADD ALL THE BYTES UP TO THE LOADER BLOCK, THEN ADD THE CHECKSUM. IF +;THERE IS NO ERROR, THEN THE BYTE RESULT WILL BE ZERO. + +ENDBLK: MOVB BCNT,@CNTPTR ;INSERT THE LOW BYTE OF COUNT + INC CNTPTR ;POINT TO THE NEXT BYTE IN BUFFER + MOVB BCNT+1,@CNTPTR ;INSERT THE HIGH BYTE + MOVB BCNT,A ;WE MUST NOW ALSO CORRECT THE CHECKSUM + ADD A,CHKSUM ;THIS IS THE KIND OF ADD WHICH SHOULD ALWAYS BE USED + MOVB BCNT+1,A ;GET THE HIGH BYTE OF THE COUNT + ADD A,CHKSUM ;IT'S A GOOD THING ADDITION IS COMMUTATIVE + NEG CHKSUM ;WHEN WE ADD IT BACK IN, THE RESULT SHOULD BE ZERO + MOVB CHKSUM,(E)+ ;PUT IT INTO THE BUFFER + TST TAPLEF ;ARE WE PUNCHING TAPE? + BLT ENDBL1 ;NOPE + JSR PC,FLUSHB ;YES, PUNCH THIS BLOCK OUT + JSR PC,TAPSPA ;AND SPACE THE TAPE +ENDBL1: RTS PC + +;FLUSHB WRITES THE BUFFER INTO THE FILE IN FILCAP AND RESETS THE BUFFER POINTER +;TO THE BEGINNING OF THE BUFFER + +FLUSHB: SUB #BUFADR,E + BEQ FLUSH1 + NEG E + SAVE <#BUFADR,E,FILCAP> ;ARGUMENTS TO BLKO + .BLKO + ERROR ,CMD + MOV #BUFADR,E ;RESET THE POINTER +FLUSH1: RTS PC + +TAPLED: SAVE A + MOV #10.,A +1$: JSR PC,TAPSPA + SOB A,1$ + REST A + RTS PC + +TAPSPA: TST TAPLEF + BLT TAPSP2 + SAVE A + MOV #10.,A ;LEAVE 10. BLANKS BETWEEN LOAD BLOCKS +TAPSP1: SAVE <#0,FILCAP> + .BYTO + ERROR ,CMD + SOB A,TAPSP1 + REST A +TAPSP2: RTS PC + +;NEWPAG MAPS IN PAGES OF THE USER'S SPHERE, UNLESS SYMFLAG IS SET. IF +;SYMFLAG IS ZERO, THEN IT IS GETTING PROGRAM BYTES FROM THE USER'S SPHERE. IN +;THIS CASE, IT MAPS THE USER'S PAGE INTO DDT'S PAGE 0 USING MAPWRD AND CHECKS +;TO SEE IF THERE IS ANY DATA ON THIS PAGE. IF SO, IT SETS THE NUMBER OF BYTES +;IN D AND GETS THE FIRST ONE. IF NOT, IT TRIES TO MAP IN THE NEXT PAGE. IF THERE +;ARE NO PAGES LEFT, IT SETS Z AND RETURNS. NOTE THAT IT ONLY READS FROM I SPACE. +;WHEN SYMFLAG IS SET, NEW PAGE SIMPLY FAILS SINCE THE SYMBOLS ARE NOT MAPPED. + +NEWPAG: TSTB SYMFLG ;ARE WE DOING SYMBOLS? + BNE NEWPA2 ;YES, SIMPLY FAIL BECAUSE NOTHING IS LEFT +NEWPA1: MOV SPAG,A ;GET THE CURRENT SOURCE PAGE + CMP A,#10 ;HAVE WE GOTTEN ALL THE PAGES + BGE NEWPA2 ;YES, SET Z TO INDICATE WE'RE DONE + INC SPAG ;ADVANCE PAGE FOR NEXT TIME + ASH #5,A ;PUT THE PAGE NUMBER IN BITS 13-15 FOR MAPWRD + SWAB A ;NOTICE THAT ALL THE OTHER BITS SHOULD BE ZERO + MOV #.CRRD,C ;ONLY NEED READ ACCESS + JSR PC,MAPWRD ;TRY TO MAP THE PAGE IN, CLR Z IF SUCCESSFUL + BEQ NEWPA1 ;NOTHING ON THAT PAGE, TRY THE NEXT ONE + ;IF SUCCESSFUL MAPWRD KINDLY RETURNS POINTER IN C + INC A ;SINCE 0 IS 1 + ASH #2,A ;MAPWRD RETURNS PAGE LENGTH IN BLOCKS IN A + SWAB A ;CHANGE BLOCKS INTO BYTES + MOV A,D ;AND SAVE AS PAGE LENGTH + CLZ ;INDICATE SUCCESS + RTS PC +NEWPA2: SEZ ;ELSE WE'RE DONE + RTS PC + + +;PUTBYT SIMPLY PUTS THE BYTE IN A INTO THE BUFFER UNLESS THERE IS ONLY ROOM IN THE +;BUFFER FOR THE CHECKSUM. SINCE WE DO NOT WANT TO HAVE TO BACK UP THE FILE TO +;PUT IN THE COUNT, WE CANNOT LET A LOADER BLOCK CROSS A BUFFER BOUNDRY, THUS WE +;MUST END EVERY LOADER BLOCK WHEN WE COME TO THE END OF THE BUFFER. +;IT ALSO ENDS A BLOCK IF THE TAPE IS DECLARED TOO LONG + +PUTBYT: TST TAPLEF ;TAPLEF <0 IF GOING TO FILE + BLT PUTBY2 + DEC TAPLEF + BGT PUTBY2 + MOV TAPLEN,TAPLEF ;END THIS BLOCK, SET LENGTH FOR NEXT ONE + JSR PC,NEWBLK ;END ONE, START ANOTHER + SAVE <#66,FILCAP> + .BYTO ;OUTPUT EOT CHAR + ERROR ,CMD + JSR PC,TAPLED ;PUNCH A LEADER TAPE + SAVE A + TYPEIT + JSR PC,TYI1 + REST A + JSR PC,TAPLED ;PUNCH ANOTHER LEADER + +PUTBY2: CMP E,#BUFADR+BLEN-1 ;ARE WE AT THE END OF THE BUFFER? + BLO PUTBY1 ;NO, JUST INSERT THE BYTE + JSR PC,NEWBLK +PUTBY1: MOVB A,(E)+ ;MOVE THE BYTE AND INCREMENT POINTER + ADD A,CHKSUM ;COMPUTE CHECKSUM + INC BCNT ;INCREMENT THE BYTE COUNT + RTS PC + +NEWBLK: SAVE A + JSR PC,ENDBLK ;END THIS BLK + DEC C ;SINCE C WAS ALREADY INCREMENTED + JSR PC,BEGBLK ;AND START A NEW ONE. BEGBLK FLUSHES THE BUFFER FIRST + INC C ;PUT IT BACK + REST A + RTS PC + +;PUTWRD ACCEPTS A WORD IN A, AND DOES TWO PUTBYTS TO PUT THIS IN THE BUFFER + +PUTWRD: SAVE A + MOVB (P),A ;INSERT THE LOW BYTE + JSR PC,PUTBYT + MOVB 1(P),A ;INSERT THE HIGH BYTE + JSR PC,PUTBYT + REST A ;POP THE SAVED A + RTS PC + +.SBTTL SYMBOL ADD +;SYMADD ADDS A FILE OF SYMBOLS TO THE CURRENT SYMBOL TABLE +SYMADD: JSR PC,OPNFIL ;GET A CAPABILITY TO THIS FILE + JSR PC,FILCHK ;MAKE SURE WE GOT A FILE + JSR PC,INITLD ;INITIALIZE THE LOADER VARIABLES + TST MAPADR ;IS THIS ABSOLUTE OR PURE FORMAT? + BNE SYMAD1 ;ABSOLUTE + JSR PC,PSLOAD ;ELSE LOAD IN PURE FORMAT + BR SYMAD2 ;RETURN +SYMAD1: JSR PC,PROSKP ;SKIP THE PROGRAM PART OF THE FILE + JSR PC,SYMLOD ;APPEND THESE SYMBOLS +SYMAD2: JMP FILCMD ;CLOSE THE FILE, AND GET A NEW COMMAND + +;PROSKIP SKIPS THE FIRST SEGMENT OF AN ABSOLUTE LOADER FORMAT FILE. +;THAT IS, IT SKIPS THE PROGRAM PART OF THE FILE AND SETS UP POINTERS +;TO THE SYMBOL PART. +PROSKP: JSR PC,SYMBYT ;GET A BYTE + CMPB A,#1 ;WAS IT A 1? + BNE PROSKP ;NO. LOOP UNTIL WE GET ONE + JSR PC,SYMBYT ;GET THE NEXT BYTE + TSTB A ;THE NEXT BYTE SHOULD BE ZERO + BNE PROSKP ;NO, MUST BE SOMETHING WRONG HERE + JSR PC,SYMWRD ;GET THE COUNT WORD FOR THIS LOADER BLOCK + MOV A,D ;SAVE IT IN D + JSR PC,SYMWRD ;GET THE ADDRESS OF THIS BLOCK (IGNORE IT) + SUB #6,D ;FIX UP THE COUNT + BEQ PROSK1 ;FOUND A FINAL BLOCK! WE'RE DONE + JSR PC,BLKSKP ;SKIP THE REST OF THIS BLOCK + JSR PC,SYMBYT ;SKIP THE CHECKSUM + BR PROSKP ;KEEP READING BLOCKS +PROSK1: JSR PC,SYMBYT ;SKIP THE CHECKSUM, POINTER NOW SET FOR SYMLOD + RTS PC + +;BLKSKP WORKS LIKE SYMMOV EXCEPT IT SIMPLY SKIPS THE BLOCK INSTEAD OF MOVING +;IT TO MEMORY. +BLKSKP: MOV #MAPADR+BLKL,A ;GET THE LENGTH OF A BLOCK + SUB B,A ;GIVES THE NUMBER OF BYTES LEFT IN BUFFER + CMP A,D ;IS THE REST OF THE LOADER BLOCK IN BUFFER? + BGE BLKSK1 ;YES + SUB A,D ;THIS MUCH NOT IN BUFFER + SAVE D + MOV A,D ;WE WILL SKIP THIS MANY + JSR PC,BLKSK1 ;SKIP EVERYTHING IN BUFFER + JSR PC,SYMMAP ;MAP IN A NEW BUFFER + REST D + BR BLKSKP ;TRY IT AGAIN +BLKSK1: ADD D,B ;FIX UP BUFFER POINTER + CLR D ;NOTHING LEFT IN THIS LOADER BLOCK + RTS PC + +;SYMFIX MAKES SURE THAT THE SYMBOL TABLE IS ON A HKWORD-REGWORD BOUNDRY BY +;ADDING ENOUGH NULL (ALL ZERO) ENTRIES TO ENSURE THAT IT IS. +SYMFIX: SAVE B ;NEED A REGISTER + CLR A ;FOR THE DIVIDE + MOV #SYMBEG,B ;SYMBEG IS THE START OF THE SYMBOL TABLE + SUB SYMEND,B ;WE HAVE THIS MANY BYTES OF SYMBOLS + DIV #<16.*3+2>*2,A ;DIVIDE BY THE NUMBER OF BYTES IN HKWORD BLOCK + TST B ;IS THE REMAINDER ZERO? + BEQ SYMFI3 ;YES, NOTHING TO FIX + MOV SYMEND,E + SUB B,E ;THIS WILL BE THE BOTTOM OF SYMBOLS + CMP E,#SYMBEG ;WRAP AROUND + BLO SYMFI1 ;NO + TYPEIT + JMP FILCMD +SYMFI1: MOV SYMEND,A ;OTHERWISE ZERO THE REMAINDER NUMBER OF BYTES + NEG B ;NUMBER OF BYTES IN THIS BLOCK + ADD #<16.*3+2>*2,B ;ADD 144 + MOV A,E ;GOT ENOUGH CORE? + SUB B,E ;GET THE BOTTOM ADDRESS +2$: CMP B,SYMBOT ;BIGGER THAN BOTTOM OF CORE? + BHI 1$ ;GO TO IT + JSR PC,PAGADD ;ADD A PAGE + BR 2$ ;TRY AGAIN +1$: ASR B ;MAKE IT WORD COUNT +SYMFI2: CLR -(A) + SOB B,SYMFI2 + MOV A,SYMEND ;MAKE THIS THE NEW SYMEND +SYMFI3: REST B + RTS PC + +.SBTTL DIRECTORY SET AND PRINT + +;SETDEF SETS THE DEFAULT DIRECTORY TO A NEW VALUE +SETDEF: JSR PC,OPNDIR ;RETURNS A CAPABILITY TO THE SPECIFIED FILE + MOV FILCAP,A ;THE FILE CAPABILITY + JSR PC,FILINF ;GET THE TYPE OF FILE + ERROR ,FILCMD + CMP A,#1 ;MAKE SURE IT'S A DIRECTORY + BEQ SETDE1 ;IT IS + SEZ ;SIGNAL AN ERROR + ERROR ,FILCMD +SETDE1: MOV #DEFCAP,A ;THE FILE TO GET INFO ABOUT + JSR PC,FILINF ;SEE IF THERE IS ANYTHING TO DELETE + ERROR ,FILCMD ;WE CANNOT READ FILE INFO + TST A ;IS THERE ANYTHING TO DELETE + BEQ SETDE2 ;NO + INVOK. #DEFCAP,#.DELCP ;DELETE THE OLD DEFAULT DIRECTORY + ERROR ,FILCMD +SETDE2: INVOK. FILCAP,#.CPYCP,#0,#DEFCAP ;COPY FILE CAP INTO DEFAULT + ERROR ,FILCMD + JMP FILCMD + +;PRDIR LISTS A DIRECTORY. IT EXPECTS TO BE GIVEN A FILENAME OR USES DEFAULT +;AND THEN PRINTS THE NAME AND LENGTH OF ALL THE ENTRIES IN THE DIRECTORY. +PRDIR: JSR PC,OPNDIR ;GET A CAP TO A DIRECTORY + MOV FILCAP,A ;THE FILE TO GET INFO ABOUT + JSR PC,FILINF ;GET THE FILE INFORMATION + ERROR ,FILCMD + CMP A,#1 ;IS IT A DIRECTORY? + BEQ PRDIR5 ;YES + SEZ ;SIGNAL AN ERROR + ERROR ,FILCMD +PRDIR5: INVOK. FILCAP,#.FARP ;READ THE LENGTH OF THE DIRECTORY + ERROR ,FILCMD + REST + ASH #-10,B ;GET THE LENGTH IN BLOCKS + BIC #177770,B ;ISOLATE LENGTH + MMAP #MYSPHR,#.CRRD,FILCAP,#BUFPAG,#0,#0,B ;MAP IN THE DIRECTORY + ERROR ,FILCMD + MOV #BUFADR,E ;INITIALIZE POINTER TO BEGINNING OF DIR + MOV 6(E),F ;GET THE LENGTH OF THE DIR FROM SELF-ENTRY + ADD #BUFADR,F ;MAKE IT ABSOLUTE + JSR PC,PRNAM ;PRINT THE DIR NAME FROM THE SELF-ENTRY + JSR PC,CRLF + INVOK. FILCAP,#.FADI ;GET THE NUMBER OF FREE BLOCKS ON THIS DISC + ERROR <.FADI FAILED >,FILCMD + MOV 2(P),B ;GET THE DISC NUMBER + TYPEIT + JSR PC,DTYPE ;TYPE THE DISC NUMBER + TYPEIT <-> + REST B ;GET NUMBER OF FREE BLOCKS + TST (P)+ ;POP THE DISK NUMBER + JSR PC,DTYPE ;TYPE NUMBER OF FREE BLOCKS + JSR PC,CRLF + JSR PC,NEXTEN ;ADVANCE TO PARENT ENTRY,THEN SKIP IT +PRDIR3: JSR PC,NEXTEN ;ADVANCE TO NEXT ENTRY + BHIS PRDIR4 ;NO MORE ENTRIES + JSR PC,PRENT ;TYPE THIS ENTRY NAME + BR PRDIR3 ;GO BACK AND TRY TO PRINT THE NEXT ENTRY +PRDIR4: JMP FILCMD ;DELETE THE FILCAP AND GET A NEW COMMAND + +NEXTEN: MOVB (E),A ;GET THE LENGTH OF THIS ENTRY + INC A ;PUT US ON A WORD BOUNDRY + BIC #177401,A ;BECAUSE MOVB DOES SIGN EXTEND + ADD A,E ;ADVANCE TO POINTER TO NEXT ENTRY + CMP E,F ;HAVE WE GONE PAST THE END OF THE DIRECTORY + RTS PC + + ;PRENT PRINTS THE NAME OF A DIRECTORY ENTRY. IT EXPECTS E TO POINT TO +;THE FIRST BYTE OF THE ENTRY. A VERSION NUMBER IS PRINTED FOR FILES, BUT +;NOT FOR SUBDIRECTORIES. + +PRENT: MOV CURSOR,D ;SAVE THE CURSOR IN D + MOV (E),A ;GET THE HEADER WORD + SWAB A + BIC #177761,A ;ISOLATE THE TYPE FIELD, NOTE THAT IT IS WORD OFFSET + JSR PC,@PRENTB(A) ;DISPATCH OFF TYPE + JMP CRLF + +;THIS TYPE ENTRY SHOULD NOT BE IN DIRECTORY +PRNAER: TYPEIT + RTS PC + +;PRINT A FILE TYPE ENTRY +PRFENT: MOV CURSOR,D ;SAVE THE CURSOR + TYPEIT < > + JSR PC,PRNAM ;PRINT THE FILE NAME + JSR PC,PRVERN ;PRINT THE VERSION NUMBER IF IT EXISTS + MOV CURSOR,A ;GET A COPY OF THE CURSOR + SUB D,A ;FIND HOW MANY CHARS FROM START OF ENTRY + CMP A,#12 ;ARE WE 12 CHARS PAST START OF ENTRY? + BGT PRFEN1 ;YES, JUST TYPE A TAB + MOV D,B ;GET COLUMN NUMBER OF START OF ENTRY + ADD #12,B ;GET THE COLUMN WHICH IS 12 CHARS PAST START + JSR PC,SETCUR ;SET THE CURSOR HERE + TYPEIT < > ;MAKE SURE THERE IS A SPACE BETWEEN FILE NAME AND VN + BR PRFEN2 +PRFEN1: TYPEIT < > ;TYPE A TAB +PRFEN2: JSR PC,PRFLEN ;PRINT THE FILE'S LENGTH IN BLOCKS + JMP PRDAT ;GO PRINT TIME+DATE AND EXIT + +;PRINT A DIRECTORY TYPE ENTRY +PRDENT: TYPEIT < I > + JMP PRNAM ;PRINT THE DIRECTORY NAME + + ;FUNCTIONS TO PRINT VARIOUS PARTS OF AN ENTRY. +;PRVERN PRINTS THE VERSION NUMBER OF AN ENTRY. +PRVERN: MOV 2(E),B ;GET THE VERSION NUMBER + CMP B,#-1 ;-1 SIGNIFIES NO VERSION NUMBER + BEQ PRVER1 ;DON'T TYPE ANYTHING IF THERE IS NO VERSION NUMBER + TYPEIT <#> ;TYPE "#" BETWEEN NAME AND VERSION NUMBER + JSR PC,DTYPE ;TYPE THE NUMBER +PRVER1: RTS PC + +;PRFLEN PRINT THE LENGTH OF THE FILE. +PRFLEN: BIT #100000,(E) ;DO WE HAVE AN EOF WORD? + BEQ PRFLE1 ;NO, NOTHING LEFT TO TYPE ON THIS LINE + MOV 6(E),B ;GET THE BYTE POINTER + MOV B,C ;COPY IT + ASH #2,B ;START FORMING 1 WORD WITH PAGE COUNT + ROL B + MOV 4(E),A ;GET THE PAGE POINTER + ASHC #3,A ;SHIFT THE BLOCK NUMBER INTO PAGE WORD + BIC #176000,C ;CHECK IF THERE WAS ANYTHING IN THE BYTE FIELD + BEQ .+4 ;NO, DO NOTHING + INC A ;OTHERWISE INCREMENT SIZE BY 1 + MOV A,B + JSR PC,DTYPE +PRFLE1: RTS PC + +;PRNAM PRINTS THE FILE NAME OF AN ENTRY +PRNAM: MOV E,B ;GET A COPY OF THE POINTER TO ENTRY + MOV (B)+,A ;GET A COPY OF THE HEADER + TST (B)+ ;SKIP VERSION OR DIRNUM + CLR DATE + ROL A ;ARE THERE ANY EOF AND DATE-TIME WORD + BCC PRNAM5 ;NO + ADD #4,B ;SKIP THE EOF WORDS + MOV (B)+,DATE ;SAVE DATE & TIME + MOV (B)+,TIME +PRNAM5: ROL A ;ARE THERE ANY ACCESS CODES? + BCC PRNAM2 ;NO +PRNAM1: CMPB (B)+,(B)+ ;SKIP TWO BYTES + TSTB (B)+ ;IF THERE ARE MORE ACCESS CODES THE #200 BIT IS SET + BLT PRNAM1 ;YES, SKIP THEM +PRNAM2: MOV #FNLEN,C ;THIS IS THE MAXIMUM NUMBER BYTES THAT WE WILL TYPE +PRNAM3: MOVB (B)+,A ;GET A CHAR + JSR PC,TYO ;TYPE IT + TSTB -1(B) ;THE LAST BYTE OF THE STRING WILL HAVE #200 BIT SET + BLT PRNAM4 ;YES, WE ALREADY HAVE TYPED THE LAST BYTE + SOB C,PRNAM3 ;KEEP TYPING UNTIL WE HIT THE MAXIMUM + TYPEIT +PRNAM4: RTS PC + + +;PRDAT PRINTS DATE & TIME, IF ANY +PRDAT: MOV DATE,B ;PUT DATE IN B REGISTER + BEQ 5$ ;IF NO DATE & TIME, RETURN + CMP #-1,B ;SEE IF INITIALIZED + BNE PRDAT1 ;GO ON IF INITIALIZED + TYPEIT < -> ;PRINT "-" IF NOT +5$: RTS PC ;EXIT + +PRDAT1: TYPEIT < > ;PRINT 2 BLANKS + ASH #-5,B ;SHIFT MONTH TO LOW BYTE + BIC #177760,B ;ZAP ALL ELSE + JSR PC,DTYPE ;PRINT MONTH + TYPEIT + MOV DATE,B ;RESET B + BIC #177740,B ;ZAP ALL ELSE + JSR PC,ZTYPE ;PRINT DAY + TYPEIT + MOV DATE,B ;RESET B + ASH #-9.,B ;SHIFT YEAR TO LOW BYTE + BIC #177600,B ;ZAP ALL ELSE + JSR PC,ZTYPE ;PRINT YEAR + + TYPEIT < > ;PRINT 2 BLANKS + MOV TIME,B ;MOVE TIME INTO B + ASH #-13,B ;SHIFT HOUR TO LOW BYTE + BIC #177740,B ;ZAP ALL ELSE + JSR PC,DTYPE ;PRINT HOUR + TYPEIT <:> + MOV TIME,B ;RESET B + ASH #-5,B ;SHIFT MINUTE TO LOW BYTE + BIC #177700,B ;ZAP ALL ELSE + JSR PC,ZTYPE ;PRINT MINUTE + TYPEIT <:> + MOV TIME,B ;RESET B + BIC #177740,B ;ZAP ALL BUT SECONDS/2 + ASL B ;MULTIPLY BY 2 + JSR PC,ZTYPE ;PRINT SECONDS + RTS PC + +.SBTTL FILE PRINT +;PRFILE PRINTS THE CONTENTS OF A FILE. +PRFILE: JSR PC,OPNFIL ;OPEN THE FILE FOR READING + JSR PC,FILCHK ;MAKE SURE IT'S A FILE + INVOK. FILCAP,#.FARE ;GET ITS LENGTH + ERROR ,FILCMD + REST + CLR MFLUSH ;FLAG MEANS FLUSH THE REST + JSR PC,CLEAR ;CLEAR SCREEN + INVOK. #TTOCAP,#.TTMV2*400,#0 ;WRAPAROUND MODE + ERRORB + INVOK. #TTOCAP,#.TTBIS*400,#.TMORM ;MORE ENABLED + ERRORB + INVOK. #CRCAP,#.PRCAP*400,#MBRK,#-1 ;CREATE THE BREAK PROCESS + ERRORB + REST BRPRCP ;SAVE CAP IN TO DELETE IF ERROR + INVOK. #MYSPHR,#0,BRPRCP ;ATTACH IT TO MYSPHR + ERRORB + INVOK. BRPRCP,#<.PRSTOP+.PRWRT>*400,#0 ;START IT + ERRORB + TST D + BNE PRFIL2 ;YES, THERE IS SOMETHING HERE +PRFIL1: TST C + BEQ PRFIL3 ;FILE IS EMPTY + DEC D + DEC C +PRFIL2: SAVE FILCAP + .BYTI ;GET A BYTE FROM THE FILE + ERRORB + REST A ;PUT THE BYTE IN A + SAVE + .BYTO + TST MFLUSH ;SHOULD WE FLUSH THE REST? + BNE PRFIL3 ;YES + SOB D,PRFIL2 + BR PRFIL1 +PRFIL3: INVOK. BRPRCP,#.DELCP*400 ;DELETE THE BREAK PROCESS + ERRORB + INVOK. #TTOCAP,#.TTMV2*400,#.TSCRL ;GO BACK TO SCROLL MODE + ERRORB + INVOK. #TTOCAP,#.TTBIC*400,#.TMORM ;QUIT MORE MODE + ERRORB + JSR PC,CRLF ;TYPE A CRLF TO CLEAN UP + JMP FILCMD ;DONE + +MBRK: MOV #MPDL,P ;INITIALIZE THE PDL + INVOK. #TTOCAP,#.TTBRK*400,#0,#.TTMBK + ERRORB + REST A + CMP A,#.TTMBK ;MAKE SURE IT WAS A MORE BREAK + BEQ .+4 + BPT + TYPEIT <**MORE**> + JSR PC,STYI ;GET A CHAR + CMP A,#40 ;WAS IT A SPACE? + BNE MBRK1 ;NO, FLUSH THE REST + JSR PC,TYI ;GET THE SPACE + INVOK. #TTOCAP,#.TVCL*400 ;CLEAR SCREEN + ERRORB + INVOK. #TTOCAP,#.TTBIC*400,#.TMORF ;RELEASE PROCESS + ERRORB + BR MBRK ;GO BLOCKED AGAIN +MBRK1: JSR PC,CRLF ;GO TO THE TOP OF THE SCREEN + TYPEIT <-FLUSHED> + JSR PC,CRLF + INC MFLUSH ;TELL HIM TO FLUSH + INVOK. #TTOCAP,#.TTBIC*400,#.TMORF ;RELEASE HIM + ERRORB + INVOK. #TTOCAP,#.TTBRK*400,#0,#0 ;BLOCK YOURSELF UNTIL DELETED + BPT ;SHOULD NEVER GET HERE + BR MBRK + +.SBTTL MISCELLANEOUS COLON COMMANDS + +STATUS: SAVE #STATS ;READ THE STATUS INTO VARIABLE BLOCK + .SSTAT + ERROR ,CMD + TYPEIT < DDT.> ;TYPE THE DDT VERSION NUMBER + MOV #VERNUM,B + JSR PC,DTYPE + MOV #STATS,F ;SYSTEM STATUS DATA + TYPEIT < SITS.> ;TYPE THE SITS VERSION NUMBER + MOV (F)+,B + JSR PC,DTYPE + TYPEIT < STIME > ;TYPE THE TIME SYSTEM HAS BEEN UP + MOV (F)+,D ;DOUBLE PRECISION INTEGER + MOV (F)+,C ;CONTAINS TIME IN 60TH'S OF SEC + DIV #60.,C ;REMAINDER IN D, IS 60TH'S + MOV C,D ;NOW GET THE SECONDS + CLR C + DIV #60.,C ;SECONDS IN D, REST IN C + MOV D,E ;SAVE + MOV C,D + CLR C ;NOW SEPARATE INTO MIN AND HRS + DIV #60.,C + MOV C,B + JSR PC,DTYPE ;TYPE NUMBER OF HOURS + TYPEIT <:> + MOV D,B + JSR PC,DTYPE ;TYPE NUMBER OF MINUTES + TYPEIT <:> + MOV E,B + JSR PC,DTYPE ;TYPE NUMBER OF SECONDS + JMP CMD + +;THE FONT COMMAND EXPECTS A FONT NUMBER N LESS THAN 8, COMMA +;AND A FILE NAME. A FONT IN THAT FILE IS LOADED INTO THE +;SYSTEM INTO FONT N. +FONT: JSR PC,TYI ;GET THE SEPARATOR + JSR PC,GETTOK ;GET THE FONT NUMBER + BR FONT2 ;NORMAL RETURN +FONT1: JSR PC,CRLF ;ECHO THE CRLF + SEZ ;SIGNAL THE ERROR + BR FONT3 ;TYPE THE ERROR +FONT2: JSR PC,CRLF ;ECHO THE CRLF + TSTB NUMF ;WAS IT A NUMBER? + BEQ FONT1 ;NO + CMP B,#10 ;WAS THE NUMBER LESS THAN 8? + BGE FONT1 ;NO + INVOK. #TTICAP,#.TVFNT*400,B +FONT3: ERROR ,CMD + JMP CMD + + +;QUEST PRINTS OUT THE COLON COMMANDS. +QUEST: JSR PC,TYI ;FLUSH THE CRLF + JSR PC,CRLF ;ECHO IT + MOV #CNAMTB,F +QUEST1: MOV (F)+,A ;GET THE NEXT NAME + BEQ QUEST2 ;LAST COMMAND + JSR PC,TYPIT ;TYPE THE NAME + JSR PC,CRLF ;FOLLOWED BY CRLF + BR QUEST1 +QUEST2: JMP CMD ;DONE + + +;LOGOUT TELL SUPERIOR TO LOGOUT +LOGOUT: IOT ;TELL SUPERIOR TO LOGOUT + JMP CMD ;IN CASE WE ARE RESTARTED + + + +;CLEARSCREEN DOES EXACTLY THAT. ONLY WORKS ON TV'S +CS: JSR PC,TYI ;FLUSH THE SEPARATOR +CS1: JSR PC,CLEAR ;CLEAR THE SCREEN + JMP CMD ;RETURN + +;SUBROUTINE FOR CLEARING THE SCREEN +CLEAR: MOV #14,A ;CONTROL L + JSR PC,TYOTYP ;TYPE CONTROL L + RTS PC + + +;REVERSESCREEN CAUSES THE IMAGE ON THE SCREEN TO BE REVERSED +REV: JSR PC,TYI + INVOK. #TTICAP,#.TVREV*400 ;REVERSE WHITE AND BLACK + ERROR ,,3 ;JUST FLUSH ARGS IF THIS LOSES + JMP CMD + +;ERROR PRINTS OUT THE TYPE OF ERROR FROM THE ALT Q VALUE +PRERR: MOV LVAL,B ;GET THE LAST VALUE + CMP B,#ERRNUM ;IS IT A LEGAL ERROR NUMBER? + BLO 1$ ;YES + JSR PC,CRLF + TYPEIT + JMP CMD ;FLUSH THIS COMMAND +1$: ASL B ;TURN INTO A WORD INDEX + SAVE ;TYPEST TAKES THIS OFF THE STACK + JSR PC,CRLF + JSR PC,TYPSTR ;TYPE THE STRIN + RTS PC + +.IFNZ LSI +;CHANGES DDT TO USE THE LSI11 +LSIDDT: DELCAP LSICAP ;DELETE THE OLD ONE + JSR PC,EVPOP ;GET A VALUE + BNE 1$ ;GOT IT! + JMP QERR ;GIVE AN ERROR +1$: JSR PC,NUMCHK ;MAKE SURE IT IS A NUMBER + STCDI AC0,B ;GET THE DECIMAL NUMBER TYPED IN. + SAVE <#-1,B,#.TTCAP*400> ;CREATE THAT CAPABILITY + .INVOK ;TRY TO CREATE IT + ERROR ,CMD + REST LSICAP ;SAVE IT FOR LATER + SAVE <,#33503,#.TTSPD*400> ;SET THE SPEED TO 9600,8 BITS, NO PARITY + MOVB LSICAP,(P) ;PUT IN THE BYTE OF CAP NUMBER + .INVOK ;SET THE SPEED + BNE 2$ ;OKAY + TYPEIT +2$: SAVE <,#3,LSICAP> + BIS #.TBRAK*400,(P) ;CAUSE BREAK TO MAKE LSI LISTEN TO US + $INVOK ;SEND IT + SAVE <,#.TIMGI!.TIMGO!.TIRST!.TORST,LSICAP> ;RESET TTY AND SET MODE + BIS #.TTMOV*400,(P) + $INVOK + SAVE <#15,LSICAP> ;SEND CR + $BYTO + JSR PC,WATLSI ;WAIT FOR THE LSI TO RESPOND +;HERE FIND THE TOP OF CORE... (TO PUT RESIDENT PORTION INTO + SAVE #167776 ;THE HIGHEST POSSIBLE LOCATION + MOV #'/,B ;FOR OPENING REGS +NXMLOP: MOV (P),A ;GET THE LOCATION TO TEST + JSR PC,ADRLSI ;ADDRESS THE LSI + SAVE ;OPEN IT + $BYTO ;SEND IT +SLSLOP: SAVE LSICAP ;WAIT FOR SLASH TO COME BACK + $BYTI + CMPB (P)+,B ;SLASH? + BNE SLSLOP ;NO + SAVE LSICAP ;NOW IS NEXT CHAR NUMBER OR ? + $BYTI + CMPB (P)+,#'? ;NXM? + BNE NXMDON ;FINISHED WITH CORE TEST + JSR PC,WATLSI ;WAIT FOR CRLF + SUB #10000,(P) ;SUBTRACT ANOTHER 2K + BR NXMLOP ;TRY TRY AGAIN +NXMDON: REST MEMT ;FOUND TOP OF MEMORY + RTS PC + +SITDDT: DELCAP LSICAP ;DELETE THE LSI CAP + RTS PC ;AND THAT IS IT + +;WAITS FOR THE LSI TO TYPE BACK @, THEN CLEARS THE INPUT BUFFER +;CLOBBERS A +WATLSI: MOV #6.,A ;NUMBER OF TIMES TO WAIT +WATLOP: SAVE <,,LSICAP> ;WAIT FOR THE LSI TO TYPE @ + BIS #.TTPEK*400,(P) ;SEPEEK FOR A CHARACTER + $INVOK ;CHARACTERS? + TST (P)+ + BMI NOCHAR ;NOPE + SAVE LSICAP ;GET THE BYTE + $BYTI + CMPB (P)+,#'@ ;GOT @? + BNE WATLOP ;NOPE +CLRLSI: SAVE <,#.TIRST,LSICAP> ;RESET THE INPUT BUFFER + BIS #.TTBIS*400,(P) + $INVOK + RTS PC +NOCHAR: SAVE <#0,#6> ;SNOOZE FOR A BIT + $SLEEP ;ZZZZZZ---ZZZZZ + SOB A,WATLOP ;DO IT A FEW TIMES AND THEN + TYPEIT + JMP CMD + +;ADDRESSES A REGISTER IN THE LSI BY TYPEING RX/, REG NUMBER IN A +OPNREG: JSR PC,CLRLSI ;CLEAR OUT BUFFER + SAVE A + ADD #'0,A ;CHANGE IT TO A DIGIT + SWAB A ;TO PUT NUMBER IN TOP BYTE + BIS #'R,A ;MAKE IT RX + SAVE ;OUTPUT IT + $WRDO + SAVE <#'/,LSICAP> ;OUTPUT THE / + $BYTO + REST A + RTS PC + +;SENDS ADDRESS IN A TO THE LSI BY TYPEING IT +ADRLSI: SAVE ;NEED REG. + MOV #6,C ;NUMBER OF CHARS TO SEND +TYPLOP: MOV A,B ;GET THE REMAINDER FROM LAST DIVISION + CLR A ;FOR DIVIDE + DIV #10,A ;PICK OFF NEXT CHARACTER + ADD #'0,B ;CHANGE TO CHARACTER + SAVE B ;TO INVERT THE ORDER + SOB C,TYPLOP ;FOR 6 CHARACTERS + MOV #6,C ;RESET THE COUNTER +ADRLS1: SAVE LSICAP ;SAVE THE CAP TO LSI + $BYTO + SOB C,ADRLS1 ;TYPE ALL CHARS OFF STACK + REST + RTS PC + +;RETURNS VALUE IN B +LSIVAL: SAVE A + MOV #6,A ;NUMBER OF CHARACTERS WE ARE LOOKING FOR +LSIVL2: SAVE LSICAP ;GET THE CAP.. + $BYTI ;FIRST WORD + REST B + CMPB B,#'/ ;SLASH YET? + BNE LSIVL2 ;NO + CLR B ;FORGET IT +LSIVL1: ASH #3,B + SAVE LSICAP + $BYTI ;GET CHARACTER + CMPB (P),#'9 ;IS IT A NUMBER + BHI 2$ ;NOPE, MUST BE A '? FROM NXM + SUB #'0,(P) ;TURN INTO A REAL CHARACTER + BPL 1$ ;GOOD NUMBER +2$: JMP NXMTRP ;LOSER TYPES SOMETHING WE DONT WANT TO SEE +1$: BISB (P)+,B ;SET IN THIS NUMBER + SOB A,LSIVL1 ;FOR ALL THE CHARACTERS + REST A + RTS PC +.ENDC + +;COPYS A FILE +COPY: JSR PC,OPNFIL ;OPEN THE FILE + TYPEIT ;TYPE TO: + MOV FILCAP,FILCP1 ;COPY THE CAPABILITY NUMBER + JSR PC,CRFIL ;GET THE FILE + INVOK. FILCP1,#.FARE ;READ THE LENGTH OF THE FILE + REST ;GET BACK THE LENGTH + CLR C ;THE NUMBER OF THE PAGE WE ARE COPYING +PAGLOP: $MMAP #MYSPHR,#.CRRD,FILCP1,#BUFPAG,C,#0,#-1 ;MAP IN ALL THE BYTES ON THIS PAGE + SAVE #BUFADR ;THE BUFFER ADDRESS + TST A ;A FULL PAGE OF BYTES + BNE 1$ ;FOR SURE + CMP B,#20000 ;ARE THERE MORE THAN A FULL PAGE? + BHIS 1$ ;YES + NEG B ;NEGATIVE NUMBER OF BYTES + SAVE B ;BYTE COUNT + CLR B ;NO MORE NEXT TIME + BR 2$ ;OUTPUT THE STUFF +1$: SAVE #-20000 ;THE BYTE COUNT OF A FULL PAGE + SUB #20000,B ;FIX UP THE BYTE COUNT ALSO + SBC A ;DECREMENT THE TOP PART ALSO +2$: SAVE FILCAP ;OUTPUT TO THE SECOND FILE + .BLKO ;OUTPUT THE BLOCK + ERROR ,FILCMD ;AND DELETE THE CAPS + INC C ;NEXT BLOCK + TST A ;ANY BYTES LEFT + BNE PAGLOP ;YES, DO THE NEXT PAGE + TST B ;MORE? + BNE PAGLOP ;GO DO IT + $MMAP #MYSPHR,#.CRRD,#-3,#BUFPAG,#0,#0,B + JMP FILCMD ;DELETE THE TWO FILE CAPABILITIES + +.SBTTL STRING ROUTINES + +;READST READS A STRING WHICH IS DEFINED AS CHARS FOLLOWED BY CR. THE +;STRING IS PLACED IN THE FIELD POINTED TO BY A, WITH A ZERO IN PLACE +;OF THE CR. THE LENGTH OF THE FIELD SHOULD BE SPECIFIED IN B, AND ROUTINE +;RETURNS WITH THE NUMBER OF CHARS READ IN A, AND Z SET IF THE STRING +;OVERFLOWS THE FIELD +READST: SAVE + MOV A,C ;C WILL POINT TO THE NEXT SLOT IN FIELD + TST B ;WERE WE CALLED WITH ZERO LENGTH FIELD? + BEQ READS2 ;YES, OVERFLOW +READS1: JSR PC,TYI ;GET A CHAR + CMPB A,#15 ;WAS THE CHAR A CR? + BEQ READS3 ;YES + MOVB A,(C)+ ;PUT THE CHAR INTO THE FIELD + SOB B,READS1 ;GET ANOTHER CHAR UNLESS WE'RE OUT OF ROOM +READS2: MOV C,A + REST C + SUB (P)+,A ;GET THE THE NUMBER OF CHARS READ + SEZ ;FAIL + RTS PC +READS3: CLRB (C) ;PUT THE ZERO AT THE END OF THE STRING + MOV C,A + REST C + SUB (P)+,A ;GET THE NUMBER OF CHARS READ + CLZ ;SUCCEED + RTS PC + +;READWD READS A WORD FROM INPUT STREAM WHERE A WORD IS DEFINED AS ANYTHING +;FOLLOWED BY SPACE OR CR. THE STRING IS PUT INTO THE FIELD (ASCIZ) POINTED TO BY A. +;THE TERMINATING CHAR IS NOT REMOVED FROM INPUT STREAM, BUT IS RETURNED IN B. +;THE COUNT IS RETURNED IN A, AND Z IS SET ON OVERFLOW. +READWD: SAVE + MOV A,C + TST B ;WERE WE CALLED WITH ZERO LENGTH FIELD? + BEQ READS2 ;OVERFLOW LIKE READS +READW1: JSR PC,STYI ;READ A CHAR INTO A, BUT DON'T REMOVE FROM STREAM + CMPB A,#15 ;WAS CHAR A LF? + BEQ READW3 ;YES, SUCCEED + CMPB A,#40 ;WAS IT A SPACE + BEQ READW3 ;ALSO SUCCEED + JSR PC,TYI ;REMOVE THE CHAR FROM THE STREAM + MOVB A,(C)+ ;OTHERWISE, INSERT THE CHAR + SOB B,READW1 ;GET CHARS UNTIL THE LENGTH COUNT RUNS OUT + BR READS2 ;IF THE COUNT RUNS OUT, THEN OVERFLOW +READW3: MOV A,B ;RETURN THE TERMINATOR IN B + MOV C,A + CLRB (C) ;INSERT THE ZERO FOR ASCIZ + REST C + SUB (P)+,A ;RETURN THE COUNT IN A + CLZ ;SUCCEED + RTS PC + +;MOVSTR MOVES AN ASCIZ STRING FROM ONE FIELD TO ANOTHER. IT EXPECTS A +;POINTER TO THE SOURCE FIELD IN A, A POINTER TO THE DESTINATION FIELD +;IN B AND THE LENGTH OF THE DESTINATION FIELD IN C. IT SETS Z IF THE +;DESTINATION FIELD IS OVERFLOWED. +MOVSTR: TST C ;WERE WE CALLED WITH ZERO LENGTH DEST FIELD? + BEQ MOVSTR2 ;YES, OVERFLOW +MOVST1: MOVB (A)+,(B)+ ;MOVE A BYTE + BEQ MOVST3 ;IF IT WAS A ZERO, THEN WE'RE DONE + SOB C,MOVST1 ;CONTINUE MOVING UNLESS NO LENGTH LEFT +MOVST2: SEZ ;FAIL + RTS PC +MOVST3: CLZ ;SUCCEED + RTS PC + +;CCTSTR CONCATENATES ONE ASCIZ STRING TO ANOTHER. A SHOULD CONTAIN A POINTER +;TO THE STRING TO BE APPENDED. B SHOULD CONTAIN A POINTER TO A FIELD CONTAINING +;AN ASCIZ STRING WHICH IS THE STRING WHICH IS TO BE APPENDED TO. C SHOULD +;CONTAIN THE LENGTH OF FIELD POINTED TO BY B. CCTSTR SETS Z IF THE FIELD OVERFLOWS. +CCTSTR: TST C ;IS IT A ZERO LENGTH FIELD? + BEQ MOVST2 ;FAIL LIKE MOVSTR +CCTST1: TSTB (B)+ ;LOOK FOR THE ZERO AT THE END OF THE B STRING + BEQ CCTST2 ;FOUND IT + SOB C,CCTST1 ;KEEP LOOKING UNTIL THE END OF THE FIELD + BR MOVST2 ;IF NOT FOUND THEN OVERFLOW FAIL +CCTST2: DEC B ;BACK UP TO THE ZERO + BR MOVST1 ;NOW CONTINUE AS MOVST + +;CMPSTR COMPARES TWO ASCIZ STRINGS POINTED TO BY A AND B. Z IS SET IF THEY +;ARE IDENTICAL, AND CLEARED IF THEY ARE DIFFERENT. +CMPSTR: CMPB (A)+,(B)+ ;COMPARE A BYTE + BNE MOVST3 ;CLEAR Z AND RETURN + TSTB -1(B) ;ARE WE AT THE END OF THE STRING? + BNE CMPSTR ;NO, CONTINUE COMPARING + BR MOVST2 ;SET Z AND RETURN + +.SBTTL SUBROUTINES FOR FILE I/O + +;OPEND EXPECTS A POINTER TO AN ASCIZ STRING IN A. IT USES +;THIS STRING TO GET A CAPABILITY TO A DIRECTORY SPECIFIED BY THE +;STRING. IT LOOKS FOR A FILE NAME IN THE STRING AND IF ONE IS FOUND +;IT COPIES TO FILNAM. IF IT SUCCEEDS, IT CLEARS Z AND LEAVES THE CAP +;NUMBER IN A, ELSE IT SETS Z. +OPEND: SAVE ;SAVE SOME REGISTERS + MOV A,B ;COPY POINTER TO STRING +OPEND1: TSTB (B) ;ARE WE AT THE END OF THE STRING YET? + BEQ OPEND2 ;NO + CMPB (B)+,#'; ;IS THIS CHAR A SEMI? + BNE OPEND1 ;NO, CHECK NEXT CHAR +OPEND2: CMPB -1(B),#'; ;DID WE FIND A SEMICOLON? + BEQ OPEND3 ;YES + MOV A,B ;ELSE JUST MUTATE THE WHOLE STRING + MOV #DEFCAP,A ;USE THE DEFAULT DIRECTORY AS ROOT + BR OPEND4 +OPEND3: SAVE B ;SAVE THE POINTER + JSR PC,RTPARS ;PARSE THE ROOT STRING TO GET ROOT CAP + ERROR ,OPEND6,1 ;IN CASE IT IS A BAD ROOT NAME + REST B ;THE POINTER +OPEND4: SAVE A ;SAVE THE ROOT CAP NUMBER + MOV B,A ;COPY POINTER TO BEGINNING OF STRING + TSTB (B)+ ;ARE WE AT ZERO? + BNE .-2 ;LOOP UNTIL WE ARE + DEC B ;BACK UP TO ZERO + JSR PC,FINDNS ;FIND A NON SPACE + BNE OPEND8 ;FOUND ONE + CLRB (A) ;NOTING FOR DIRNAM STUFF TO MUTATE + CLRB FILSTR ;ALSO, NO FILE NAME + BR OPEND7 ;COPY THE ROOT AND RETURN +OPEND8: JSR PC,FINDSP ;NOW FIND A NON QUOTED SPACE OR END OF STRING + SAVE + MOV B,A ;POINTER TO START OF FILE NAME + MOV #FILSTR,B ;FILE NAME BUFFER + MOV #FLSLEN,C ;LENGTH OF FILE NAME BUFFER + JSR PC,MOVSTR ;MOVE THE FILE NAME + ERROR ,OPEND6,3 ;NAME TOO LONG ERROR, JUST POP THE STUFF ON STACK + REST + CLRB (B) ;PUT IN A ZERO TO SIGNAL THE END OF THE STRING + JSR PC,FINDNS ;FIND A NON-SPACE + BNE OPEND7 ;FOUND ONE + CLRB (A) ;NOTHING BUT SPACES FOUND, SO NOTHING TO MUTATE +OPEND7: REST C ;THE ROOT CAPABILITY + INVOK. C,#.CPYCP,#0,#-1 ;COPY THE CAP WE ARE USING AS ROOOT + ERROR ,OPEND6,3 + REST FILCAP ;THE NEW CAPABILITY + TSTB (A) ;IS THERE ANYTHING TO MUTATE? + BEQ OPEND5 ;NO + INVOK. FILCAP,#.FAMU,A ;MUTATE IT + ERROR ,OPEND6,3 +OPEND5: MOV FILCAP,A ;RETURN THE CAP IN A + REST ;CLEAN UP + CLZ ;WIN + RTS PC ;Z MUST BE CLEARED +OPEND6: REST ;CLEAN UP + SEZ ;FAIL + RTS PC + +;RTPARS GETS A POINTER TO A STRING IN A, AND A POINTER TO +;THE NEXT BYTE AFTER THE STRING IN B AND RETURNS THE NUMBER +;OF THE CAPABILITY OF THE ROOT SPECIFIED BY THE STRING IN A. +RTPARS: CMP A,B + BEQ RTPAR3 + CMPB -(B),#'; ;SET POINTER TO SEMI + BNE RTPARS ;ELSE BACK UP + CMP A,B ;DID HE GIVE A NUMBER BEFOR SEMI? + BNE RTPAR1 ;YES + CLR A ;NO, USE ZERO + BR RTPAR2 +RTPAR1: MOVB -(B),A ;GET THE NUMBER + CMPB A,#40 ;IS IT A SPACE + BNE RTPAR4 ;NO + CLR A ;USE ZERO + BR RTPAR2 +RTPAR4: SUB #'0,A ;CONVERT TO NUMBER + BLT RTPAR3 ;BAD NUMBER + CMP A,#MAXDSK ;IS THE NUMBER LEGAL? + BGT RTPAR3 ;NO +RTPAR2: ADD #10,A ;CONVERT TO ROOT CAP NUMBER + CLZ ;SUCCEED + RTS PC +RTPAR3: SEZ ;FAIL + RTS PC + +;FINDNS FINDS A NON SPACE IN A STRING. EXPECTS A POINTING TO BEGINNING +;OF STRING AND B POINTING TO END. LEAVES B AT NON SPACE IF SUCCEEDS. +FINDNS: CMP B,A ;ANYTHING HERE? + BEQ FINDN1 ;NO + CMPB -(B),#40 ;IS IT A SPACE? + BEQ FINDNS ;YES + CLZ ;WIN + RTS PC +FINDN1: SEZ ;LOSE + RTS PC + +;FINDSP LOOKS FOR A SPACE IN A STRING. IT KNOWS ENOUGH TO IGNORE QUOTED +;SPACES. USES POINTERS LIKE FINDNS. +FINDSP: CMP B,A ;ANYTHING HERE? + BEQ FINDS2 ;NO + CMPB -(B),#40 ;IS THIS A SPACE + BNE FINDSP ;NO + CMP B,A ;ARE THERE ANY MORE CHARS? + BEQ FINDS1 ;NO, THIS IS NOT A QUOTED SPACE + CMPB -1(B),#'" ;WAS THIS SPACE PROCEEDED BY QUOTE? + BEQ FINDSP ;YES CONTINUE SEARCHING +FINDS1: CLZ ;WIN + RTS PC +FINDS2: SEZ ;FAIL + RTS PC + +;OPENF MUTATES FROM THE DIRECTORY TO FILE. EXPECTS CAP TO DIRECTORY IN A. +OPENF: TSTB FILSTR ;IS THERE ANYTHING TO MUTATE? + BEQ OPENF1 ;NO + INVOK. A,#.FAMU,#FILSTR ;MUTATE TO THE FILE + ERROR ,OPENF2,3 +OPENF1: CLZ ;WIN + RTS PC +OPENF2: SEZ ;FAIL + RTS PC + + +;OPEN EXPECTS A POINTER TO AN ASCIZ STRING IN A AND RETURNS CAP TO +;FILE DESCRIBED BY THAT STRING IN A. THE STRING IS MUTATED FROM +;THE DEFAULT DIRECTORY UNLESS A ROOT IS SPECIFIED. IF THE STRING +;IS NULL, THE THE DEFAULT FILE NAME, SAVED IN FILNAM IS USED. +OPEN: JSR PC,OPEND ;OPEN AS FAR AS THE DIRECTORY + ERROR ,OPEN2 + TSTB FILSTR ;IS THERE A FILE NAME? + BEQ OPEN1 ;NO, JUST USE DIRECTORY NAME + JSR PC,OPENF ;OPEN THE REST OF THE WAY + ERROR ,OPEN2 +OPEN1: CLZ ;WIN + RTS PC +OPEN2: SEZ ;FAIL + RTS PC + +;CREATE GETS POINTER TO FILE NAME, DELETES ANY EXISTING FILES BY THAT +;NAME, ADDS THE FILE TO DIRECTORY AND FINALLY RETURNS A CAPABILITY TO +;THE FILE IN A. +CREATE: JSR PC,OPEND ;GET A CAP TO THE DIRECTORY, SAVE FILE NAME + ERROR ,CREAT4 + SAVE A ;SAVE CAP TO THE DIRECTORY + INVOK. A,#.CPYCP,#0,#-1 ;GET A SECOND CAP TO DIR ON STACK + ERROR ,CREAT4,4 ;CAN'T COPY? + JSR PC,DEFAUL ;SET UP THE DEFAULT FILE NAME + MOV #FILSTR,A ;POINTER TO FILE NAME + TSTB (A) ;ERROR IF NO NAME TYPED + BNE CREAT1 ;SOMETHING IS THERE + CMP (P)+,(P)+ ;POP THE A WE SAVED + BR CREATE4 +CREAT1: TSTB (A)+ ;FIND THE ZERO? + BNE CREAT1 ;NOT YET + DEC A ;BACK UP TO THE ZERO +CREAT2: CMPB -(A),#40 ;IS PREVIOUS CHAR A SPACE + BEQ CREAT2 ;YES + CMPB (A),#'> ;IS IT A GREATER THAN? + BEQ CREAT3 ;YES, DO NOT DELETE + CMPB (A),#'< ;IS IT LESS THAN? + BEQ CREAT3 ;YES, AGAIN DO NOT DELETE + REST A ;GET THE DIRECTORY CAP + JSR PC,OPENF ;DOES THE FILE EXIST? + BEQ CREAT5 ;NO, JUST CREATE IT + INVOK. A,#.FADL ;TRY TO DELETE THE FILE + BNE CREAT5 ;SUCCEED + ADD #6,P ;ELSE POP THE ARGUMENTS + BR CREAT5 +CREAT3: REST A ;GET BACK CAPABILITY +CREAT5: INVOK. A,#.DELCP + ERROR ,CREAT4,4 + REST A + INVOK. A,#.FAAD,#FILSTR,#0 ;ADD FILE TO DIRECTORY AND MUTATE TO IT + ERROR ,CREAT4,3 ;FAILED + CLZ ;SUCCEED + RTS PC +CREAT4: SEZ + RTS PC + +;DELETE DELETES A FILE FROM A DIRECTORY. +DELETE: JSR PC,OPEND ;GET A CAP TO THE DIRECTORY + ERROR ,DELET1 ;FAILED + JSR PC,DEFAUL ;SET UP THE DEFAULTS + TSTB FILSTR ;MAKE SURE THERE IS A NAME TO DELETE + BEQ DELET1 ;NOTHING THERE + SAVE A + INVOK. A,#.CPYCP,#0,#-1 ;COPY THE DIR CAP + ERROR ,DELET1,4 + REST A + INVOK. A,#.FAMU,#FILSTR + ERROR ,DELET1,4 + INVOK. A,#.FADL ;DELETE THE FILE + ERROR ,DELET1,4 + INVOK. A,#.DELCP ;DELETE THE CAP TO FILE + ERROR ,DELET1,4 + REST A + CLZ ;WIN + RTS PC +DELET1: SEZ ;FAIL + RTS PC + + + +;OPNFIL TAKES THE THE DIRECTORY NAME IN DIRNAM AND THE FILE NAME IN FILNAM +;AND RETURNS A CAPABILITY TO THE FILE. +OPNFIL: JSR PC,SPACE ;TYPE A SEPARATOR SPACE ON NON RUBOUT SCANS + MOV #STRBUF,A ;THE BUFFER FOR THE FILE NAME + MOV #SBFLEN,B ;LENGTH OF THE BUFFER + JSR PC,READST ;READ IN THE FILE NAME + ERROR ,FILCMD + JSR PC,CRLF ;ECHO THE CRLF + MOV #STRBUF,A ;WHERE THE FILENAME IS + JSR PC,OPEND ;GET A CAPABILITY TO THE DIRECTORY + ERROR ,FNF + JSR PC,DEFAUL ;SET UP THE DEFAULTS + JSR PC,OPENF ;MUTATE THE REST OF THE WAY + ERROR ,FNF + RTS PC + +;OPNDIR IS JUST LIKE OPNFIL EXCEPT THAT IT DOES NOT USE OR SET THE +;DEFAULT FILE NAME. +OPNDIR: JSR PC,SPACE + MOV #STRBUF,A + MOV #SBFLEN,B + JSR PC,READST + ERROR ,FILCMD + JSR PC,CRLF + MOV #STRBUF,A + JSR PC,OPEND ;GET A CAP TO THE SUPERIOR DIRECTORY + ERROR ,FNF + JSR PC,OPENF ;MUTATE THE RETURNED CAP TO DIRECTORY + ERROR ,FNF + RTS PC + +;CRFIL READS A FILE NAME, DELETES ANY EXISTING FILES BY THAT NAME, ADDS +;THE FILE TO DIRECTORY AND FINALLY RETURNS A CAPABILITY TO THE FILE +CRFIL: JSR PC,SPACE ;TYPE THE SEPARATORY SPACE + MOV #STRBUF,A ;WHERE TO READ THE STRING + MOV #SBFLEN,B ;LENGTH OF THE STRING BUFF + JSR PC,READST ;READ IN A FILENAME + ERROR ,FILCMD + JSR PC,CRLF ;ECHO THE CRLF + MOV #STRBUF,A ;POINTER TO FILE NAME + JSR PC,CREATE + ERROR ,FILCMD + RTS PC + +;DELFIL DELETES A FILE FROM A DIRECTORY. IT PRINTS THE NAME OF THE DEFAULT +;FILE THEN TRIES TO READ A FILENAME. IF THE DEFAULT IS THE ONE TO BE DELETED +;JUST TYPE CR AFTER IT PRINTS THE DEFAULT, OTHERWISE, TYPE A NEW FILE NAME. +;TO ABORT THE COMMAND, TYPE ^D BEFORE THE FINAL CR. +DELFIL: JSR PC,SPACE ;TYPE THE SEPARATOR SPACE + MOV #STRBUF,A ;WHERE TO READ THE STRING + MOV #SBFLEN,B ;LENGTH OF THE BUFFER + JSR PC,READST ;READ IN THE FILE NAME + ERROR ,CMD + JSR PC,CRLF ;ECHO THE CRLF + TSTB STRBUF ;WAS ANYTHING TYPED? + BNE DELFI1 ;YES + JSR PC,PRDEF ;TYPE THE DEFAULT DIRECTORY + MOV #STRBUF,A ;WHERE TO READ IN THE STRING + MOV #SBFLEN,B ;LENGTH OF THE BUFFER + JSR PC,READST ;TRY TO READ A NEW FILENAME + ERROR ,CMD +DELFI1: MOV #STRBUF,A ;NEW FILE NAME + JSR PC,DELETE ;DELETE THE FILE + ERROR ,FILCMD + JMP FILCMD + +;DEFAUL SETS UP THE DEFAULT FILE. IF NO FILE NAME IS GIVEN, THEN +;THE CURRENT DEFAULT IS COPIED INTO FILSTR. OTHERWISE, THE NAME IN FILSTR +;BECOMES THE DEFAULT FILE +DEFAUL: SAVE + TSTB FILSTR ;WAS A FILE NAME GIVEN? + BEQ DEFAU1 ;NO + MOV #FILSTR,A + MOV #FILNAM,B + MOV #FNLEN,C + JSR PC,MOVSTR ;COPY THE GIVEN FILE NAME TO THE DEFAULT + BR DEFAU2 +DEFAU1: TSTB FILNAM ;IS THERE CURRENTLY A DEFAULT FILE? + ERROR ,CMD + MOV #FILNAM,A + MOV #FILSTR,B + MOV #FLSLEN,C + JSR PC,MOVSTR ;COPY THE DEFAULT FILE NAME INTO FILE STRING BUFFER +DEFAU2: REST + RTS PC + +;TYPE A SPACE WHEN NOT DOING A RUBOUT SCAN OF COMMAND STRING +SPACE: CMP CTYIPT,TYIPNT ;THESE ARE EQUAL ON NON-RUBOUT SCANS OF RUBOUT BUFFER + BNE SPACE1 ;A RUBOUT SCAN, SO DON'T TYPE THE SPACE + MOV #40,A ;A SPACE + JSR PC,TYO ;TYPE THE SPACE +SPACE1: RTS PC + +;PRDEF PRINTS THE DEFAULT FILE NAME WITH A LEADING AND TRAILING SPACE. +PRDEF: TYPEIT < > ;LEADING SPACE + MOV #FILNAM,A + JSR PC,TYPIT ;TYPE THE FILE NAME + TYPEIT < > ;TRAILING SPACE + RTS PC + +;NEWBUF ADDS A FRESH PAGE TO DDT IN BUFPAG +NEWBUF: MMAP #MYSPHR,#.CRWRT,#-1,#BUFPAG,#0,#0,#7 + ERROR ,NEWBU1,4 + CLZ ;WIN + RTS PC +NEWBU1: SEZ ;FAIL + RTS PC + +;FILINF IS GIVEN A CAPABILITY AND CHECKS TO SEE IF THAT CAPABILITY +;IS A FACAP AND IF SO WHAT KIND OF OBJECT IT REFERENCES. +;RETURNS IN A: +;0 - NOT A FACAP +;1 - DIRECTORY +;2 - FILE +;3 - SOMETHING OTHER THAN A FACAP +FILINF: SAVE A ;SAVE THE CAP NUMBER + INVOK. #MYSPHR,#400,A ;GET ITS TYPE + ERROR ,FILINF5,4 + REST A ;THE TYPE OF CAPABILITY + CMP A,#.FACAP ;IS IT A FACAP? + BNE FILIN3 ;NO + REST A ;GET THE CAP NUMBER BACK AGAIN + INVOK. A,#.FARI,#4,#FILFLG ;GET INFORATION ABOUT FILE + ERROR ,FILIN5,3 + BIT #.FADIR,MFIFLG ;MFI FLAGS WORD + BEQ FILIN1 ;IT'S NOT A DIRECTORY + MOV #1,A ;OH YES IT IS + BR FILIN2 ;SUCCEED +FILIN1: MOV #2,A ;THEREFOR MUST BE A FILE +FILIN2: CLZ ;WIN + RTS PC +FILIN3: TST A ;ZERO MEANS NO CAP AT ALL + BEQ FILIN4 ;LEAVE IT THAT WAY + MOV #3,A ;SOMETHING OTHER THAN FACAP +FILIN4: TST (P)+ ;POP THE SAVED CAP NUMBER + CLZ ;SORT OF WIN + RTS PC +FILIN5: SEZ ;FAIL + RTS PC + +;FILCHK MAKES SURE THAT THE FILE IN FILCAP IS A FILE AND +;NOT A DIRECTORY +FILCHK: MOV FILCAP,A ;CURRENT "FILE" + JSR PC,FILINF ;GET INFO ABOUT FILE + ERROR ,FILCMD ;IN CASE SOMETHING WRONG + CMP A,#2 ;IS IT A FILE + BEQ FILCH1 ;YES + TYPEIT + JMP FILCMD ;ERROR RETURN +FILCH1: RTS PC + +.SBTTL SUBROUTINES TO READ AND WRITE LOCATIONS + +;ADDRESS IN A, RETURNS VALUE IN B +GETWRD: SAVE ;GET A REGISTER FOR MAPWRD TO USE + CMPB SPACMD,#MPMOD ;DO WE WANT TO READ THE MAP? + BNE GETWR2 ;NO + TST A ;CHECK THE ADDRESS + BLT GETWR0 ;MUST BE A POSITIVE VALUE + CMP A,#16. ;THERE ARE ONLY 16 WORDS IN THE MAP + BLT GETWR1 ;OK +GETWR0: JMP NXMTRP ;ELSE NXM ERROR +GETWR1: ASL A ;CONVERT TO WORD OFFSET + MOV SPHMAP(A),B ;GET THE MAP WORD + BR GETWR4 +GETWR2: CMPB SPACMD,#CPMOD ;DO WE WANT TO READ THE CAPABILITY + BNE GETWR3 ;NO + TST SPHCAP ;IS THERE A SPHERE LOADED? + ERROR ,CMD + INVOK. SPHCAP,#.SPCLR*400,A ;GET THE CAPABILITY SPECIFIED BY A + ERROR ,NXMTRP ;IN CASE WE CANNOT GET THAT CAPABILITY + REST B + BR GETWR4 +GETWR3: +.IFNZ LSI + TST LSICAP ;DEBUGGING LSI? + BNE GETWR5 ;YAWN..... +.ENDC + MOV #.CRRD,C ;SAY THAT WE WANT TO READ + JSR PC,MAPWRD ;GET CORRECT PAGE INTO DDT PAGE 0 AND FIX ADDRESS + ERROR ,NXMTRP + MOV (C),B ;MAPWRD RETURNS ADDRESS IN C, SO GET VALUE IN B +GETWR4: REST + RTS PC + +.IFNZ LSI +GETWR5: JSR PC,CLRLSI ;CLEAR THE LSI + JSR PC,ADRLSI ;ADDRESS THE LSI + SAVE <#'/,LSICAP> ;TYPE SLASH TO GET IT + $BYTO + JSR PC,LSIVAL ;GET THE VALUE + BR GETWR4 ;AND RETURN IT +.ENDC +;GET BYTE AT A INTO B +GETBYT: MOV A,-(P) + BIC #1,A + JSR PC,GETWRD + MOV (P)+,A + BIT #1,A + BEQ GETBY1 + SWAB B +GETBY1: BIC #177400,B + RTS PC + +;A HAS FROM ADDRESS, D HAS TO ADDRESS, C HAS COUNT +GETBLK: JSR PC,GETWRD + MOV B,(D)+ + ADD #2,A + SOB C,GETBLK + RTS PC + + ;A HAS TO ADDRESS, D HAS FROM ADDRESS, C HAS COUNT +WRTBLK: MOV (D)+,B + JSR PC,WRTWRD + ADD #2,A + SOB C,WRTBLK + RTS PC + +;WRITE BYTE IN B AT ADDRESS IN A +WRTBYT: BIC #177400,B ;MAKE SURE TOP BYTE IS CLEAR + SAVE + MOV #.CRRD,C ;SPECIFY READ ACCESS + JSR PC,MAPWRD ;SEE IF WE HAVE READ ACCESS + ERROR ,WRTBY1 ;IF NOT, THEN WRTWRD WILL TRY TO MAKE FRESH PAGE + MOV 4(P),A ;GET THE ADDRESS BACK + BIC #1,A ;MAKE SURE WE'RE ON AN EVEN ADDRESS + JSR PC,GETWRD ;READ THE WORD AT ADDRESS INTO B +WRTBY1: BIT #1,4(P) ;DO WE WANT THE HIGH BYTE? + BNE WRTBY2 ;YES + BIC #377,B ;CLEAR THE OLD LOW BYTE + BIS 2(P),B ;SET IN THE NEW LOW BYTE + BR WRTBY3 +WRTBY2: SWAB B ;MAKE THE HIGH BYTE BE LOW + BIC #377,B ;CLEAR THE OLD HIGH BYTE + BIS 2(P),B ;SET IN THE NEW HIGH BYTE + SWAB B ;PUT THE HIGH BYTE BACK +WRTBY3: MOV 4(P),A ;GET THE ADDRESS BACK + BIC #1,A ;MAKE SURE IT'S EVEN + JSR PC,WRTWRD ;TRY TO WRITE THE WORD + REST + RTS PC + +;A HAS ADDRESS, B HAS DATA +WRTWRD: SAVE + BIT #1,A ;ODD ADDRESS + BEQ WRTWR3 ;NO + ERROR ,QERR ;FAIL MISERABLY +WRTWR3: CMPB SPACMD,#CPMOD ;ARE WE TRYING TO WRITE INTO CAPABILITY OR MAP? + BLT WRTWR0 ;NO + JMP QERR ;FOR NOW, QERR +WRTWR0: +.IFNZ LSI + TST LSICAP ;LSI? + BNE WRTWR4 ;YES +.ENDC + MOV #.CRWRT,C ;SAY THAT WE ARE TRYING TO WRITE + JSR PC,MAPWRD + ERROR ,WRTWER +WRTWR1: MOV B,@C +WRTWR2: REST + RTS PC +WRTWER: MOV (P),A ;GET BACK THE ADDRESS + JSR PC,PAGGET ;MAKE FRESH PAGE, LEAVE MAPPED ADDR IN C + ERROR ,WRTWR2 + BR WRTWR1 +.IFNZ LSI +WRTWR4: SAVE B ;SAVE WORD + JSR PC,GETWRD ;READ THE WORD + MOV (P),A ;TO TYPE WORD TO DEPOSIT + JSR PC,ADRLSI ;TYPE WORD TO DEPOSIT + SAVE <#15,LSICAP> ;OUTPUT THE CLOSE COMMAND + $BYTO + JSR PC,WATLSI + REST B + BR WRTWR2 ;DONE +.ENDC + + ;PAGADD CAUSES A FRESH PAGE TO BE ADDED TO INFERIOR SPHERE SUCH THAT +;THE PAGE SPECIFIED BY AN ADDRESS IN A IS CREATED. THE PAGE IS ZEROED. +;PAGGET RETURNS THE MAPPED ADDRESS IN C. +PAGGET: SAVE ;GET SOME REGISTERS. NOTE THAT ADDRESS IS IN A + ASH #-13.,A + BIC #177770,A ;GET THE PAGE NUMBER + ADD #20,A ;FOR NOW, ALWAYS GIVE I=D PAGES + MMAP SPHCAP,#.CRWRT,#-1,A,#0,#0,#7 ;ALSO, ALWAYS 4K PAGES + ERROR ,PAGAER,4 + JSR PC,RSTMAP ;RESET THE MAP + ERROR ,PAGAER + MOV (P),A ;GET BACK THE ORIGINAL ADDRESS + MOV #.CRWRT,C ;MAKE SURE WE HAVE WRITE ACCESS TO PAGE + JSR PC,MAPWRD ;ALSO, MAP THE PAGE IN MAPPAG. + ERROR ,PAGAER + MOV C,2(P) ;SAVE THE MAPPED VALUE OF C + MOV #MAPADR,A ;START ZEROING THE MAP PAGE. + MOV #10000,C ;THIS PAGE IS 10000 WORDS LONG +PAGAD1: CLR (A)+ + SOB C,PAGAD1 ;ZERO THE WHOLE PAGE + REST + CLZ ;SUCCEED + RTS PC +PAGAER: REST + SEZ ;FAIL + RTS PC + +;A HAS THE ADDRESS IN THE SPHERE, C HAS THE REQUESTED ACCESS +;RETURNS WITH THE PAGE LENGTH IN A, AND THE MAPPED ADDRESS IN C +MAPWRD: +.IFNZ LSI + TST LSICAP ;LSI + BEQ 3$ ;NO + RTS PC ;JUST RETURN +3$: +.ENDC + SAVE ;GET SOME REGISTERS + MOV A,B ;COPY THE ADDRESS + SWAB B ;THIS DOES A FAST ASH #-13.,B TO GET THE PAGE NUMBER + ASH #-5,B + BIC #177770,B ;WE WANT ONLY THE PAGE NUMBER + CMPB SPACMD,#SYMOD ;ARE WE IN ABSOLUTE PAGE MODE? + BEQ SYSWRD ;YES, GO MAP IT IN. + TST SPHCAP ;DO WE HAVE A SPHERE? + ERROR ,CMD + CMPB SPACMD,#DMOD ;IN D MODE? + BNE 1$ ;NO, MUST BE IN I SPACE? (HOPE SO) + ADD #10,B ;MAKE THE PAGE NUMBER FOR D SPACE +1$: ASL B ;TURN IT INTO AN INDEX + MOV SPHMAP(B),D ;GET THAT PAGE'S DATA + ASR B ;BACK TO THE RIGHT STUFF + TST D ;IS THERE A MAP WORD + BEQ MAPWER ;NO PAGE THERE? + BIT C,D ;DO WE HAVE ENOUGH ACCESS + BNE 2$ ;SKIP THE IMPURIFYING IF WE HAVE ACCESS + JSR PC,IMPURE ;IMPURIFY THAT PAGE +2$: CMP B,CURPAG ;IS THIS THE SAME AS THE CURRENT PAGE + BEQ MAPWR2 ;IT IS OKAY AS IS +MAPWR1: BIC #.PLENM,D ;CLEAR ALL BUT THE LENGTH + SWAB D ;PUT IT INTOT THE RIGHT PLACE FOR MAP + SAVE D ;AND ON THE STACK + ASL B ;SHIFT TO WORD AGAIN + MOV SPHMAP(B),D ;GET THE ACCESS STUFF + BIC #.PACCM,D ;ONLY WANT THE ACCESS FIELD + ASR B ;BACK TO A PAGE NUMBER + SAVE ;SAVE THE PAGE, SPHERE NUMBER, AND ACCESS + ADD #MYSPHR,(P) ;SET IN THE SPHERE CAP FOR THIS SPHERE + BIS #MAPPAG*400,2(P) ;MAP IT INTO THE MAP PAGE + .MAP ;MAP IN THE PAGE + ERROR ,CMD ;ALMOST SURELY A BUG. + MOV B,CURPAG ;B IS NOW THE CURRENT PAGE +MAPWR2: ASL B ;INTO WORD INDEX + MOV A,C ;COPY THE ADDRESS + MOV SPHMAP(B),A ;GET THE SPHERE MAP + BIC #.PLENM,A ;ONLY WANT THE LENGTH NOW + MOV C,B ;GET THE ADDRESS AGAIN + SWAB B ;FAST ASH #-10.,B TO GET THE BLOCK IN PAGE + ASH #-2,B + BIC #177770,B ;GET THE BLOCK NUMBER FOR THIS PAGE + CMP A,B ;SEE IF IT IS A SEGMENT LENGTH ERROR? + BLT MAPWER ;YUP +MAPWR3: BIC #MPMSK1,C ;CLEAR THE PAGE NUMBER + BIS #MPMSK2,C ;AND MAKE IT AN ADDRESS IN OUR SPHERE + REST ;GET BACK REGS + CLZ ;ALL FINISHED? + RTS PC + +MAPWER: REST ;THIS GUY IS A LOSER + SEZ + RTS PC + +SYSWRD: MOV C,D ;COPY THE ACCESS + MOV A,C ;DONT WANT TO HASSLE THE ADDRESS LATER + MOV #7,A ;THE LENGTH OF THE PAGE WE ARE GETTING + BIT #.CRWRT,D ;ASKING FOR CORE WRITE + BNE MAPWER ;PROBABLY A BUG, CERTAINLY LOSING THING TO DO + MOV CURPAG,D ;GET THE CURRENT PAGE + BPL SYSWR1 ;MUST BE A REAL PAGE + CMPB B,D ;ONLY CHECK THE BOTTOM BYTE + BEQ MAPWR3 ;MUST BE A WINNER +SYSWR1: ASH #3,B ;TURN IT INTO 512. WORD BLOCKS + SAVE <#3400,B,#-2,#.CRRD+MYSPHR> ;ABSOLUTE MAP INTO THIS SPHERE + ASH #-3,B ;TURN IT BACK INTO NICE STUFF + MOVB #MAPPAG,3(P) ;SET IN THE PAGE NUMBER OF WHERE TO PUT IT + $MAP ;SHOULDN'T FAIL + MOV B,CURPAG ;NEW CURRENT PAGE + BIS #100000,CURPAG ;DONT WANT IT TO LOOK LIKE A REGULAR PAGE!! + BR MAPWR3 + +;B HAS THE PAGE NUMBER TO IMPURIFY, ASSUMES THAT THE FILE PAGE IS NOT BEING USED +IMPURE: TYPEIT + SAVE ;SAVE SOME STUFF + JSR PC,DTYPE ;TYPE THE NUMBER + REST B ;GET BACK THE PAGE NUMBER + JSR PC,CRLF ;TYPE CARRIAGE RETURN LINE FEED + BIC #.PLENM,D ;GET THE LENGTH FIELD + SWAB D ;PUT IT INTO THE TOP BYTE + SAVE ;GET IT WITH READ ACCESS + BIS #BUFPAG*400,2(P) ;SET IN THE PAGE NUMBER + $MAP ;SHOULD NOT FAIL + SAVE ;OKAY, NOW A NEW PAGE INTO MY FILE PAGE + MOVB #MAPPAG,3(P) ;INTO THE BUFFER PAGE + .MAP ;MAP IN NEW PAGE + ERROR ,CMD + MOV D,E ;THE MAP WORD + MOV #MAPADR,A ;THE NEW PAGE ADDRESS + MOV #BUFADR,C ;THE OLD PAGE ADDRESS + SWAB D ;GET BACK THE LENGTH + INC D ;BECAUSE IT IS LENGTH-1 + ASH #9.,D ;GET THE NUMBER OF WORDS ON THIS PAGE +1$: MOV (C)+,(A)+ ;COPY THE PAGE + SOB D,1$ ;ALL THE WORDS + SAVE <,,#-3,#MYSPHR> ;JUST FLUSH THE BUFFER PAGE + MOVB #BUFPAG,3(P) ;BYE BYE TO THE PURE PAGE + $MAP ;REALLY SHOULDN'T FAIL + REST D ;GET BACK THE MAP WORD + SAVE ;SEND IT FROM MY SPHERE, TO HIS + BIS #.CRWRT,(P) ;SAY HE WANTS READ WRITE ACCESS + MOVB B,3(P) ;SET IN THE PAGE NUMBER + BIT #.PDEI,D ;SEE IF IT WAS A D=I PAGE + BEQ 2$ ;IT WASN'T + BIC #10*400,2(P) ;CLEAR THE 10 BIT IN THE PAGE NUMBER + BIS #20*400,2(P) ;AND SET IN THE D=I BIT +2$: .MAP ;INSERT THE PAGE INTO HIS MAP + ERROR ,CMD + JSR PC,RSTMAP ;READ THE MAP + MOV B,D ;COPY THE PAGE NUMBER + ASL D ;GET THE MAP WORD + MOV SPHMAP(D),D ;NOW WE HAVE IT + REST ;RESTORE THE REGS + MOV B,CURPAG ;DONT NEED TO MAP IT IN + RTS PC + + +.SBTTL SYMBOL EVALUATION AND TYPEOUT + +;CHECK EXSYMF AND IF SET TRY TO LOOK UP THE SYMBOL. DOESN'T CLOBBER +;ANY REGISTERS. CLEARS FLTF AND RETURNS THE VALUE IN B AND +;EVREGF AND SETS EXNUMF + +EVSYM: TSTB EXSYMF + BNE EVSYM1 ;YES, THERE IS A SYMBOL + RTS PC ;NO SYMBOL +EVSYM1: MOV D,-(P) + JSR PC,SYMLK + BR EVSYM2 ;SYMBOL UNDEFINED + MOV 4(B),B ;GET VALUE + BIT D,@REGWAD + BEQ EVSYM3 ;NOT A REGISTER VALUE + INCB EVREGF +EVSYM3: CLRB FLTF + INCB EXNUMF ;INDICATE RETURNING A VALUE + MOV (P)+,D + RTS PC + +EVSYM2: TYPEIT < ?U? > + JMP CMD4 + +;SYMLK SEARCHES THE SYMBOL TABLE FOR THE SYMBOL IN SYM AND SYM1. +;IT SKIP RETURNS IF IT FINDS IT RETURNING THE ADDRESS OF THE SYMBOL +;IN B, THE ADDRESS OF THE CORREPONDING REGISTER FLAG WORD IN REGWAD +;AND THE CORREPONDING BIT IN D + +SYMLK: MOV #SYMBEG,B ;WORD AFTER HKILL AND REG WORDS + CLR D +SYMLK2: ASL D + BNE SYMLK3 ;STILL MORE TO DO IN THIS BLOCK OF 16 + TST -(B) ;POINT AT REG WORD + MOV B,REGWAD + TST -(B) ;POINT AT HKILL WORD + INC D ;START AT FIRST SYMBOL +SYMLK3: SUB #6,B ;POINT AT FIRST WORD OF RADIX 50 OF NEXT SYMBOL + CMP B,SYMEND + BLO SYMLK4 ;OUT OF SYMBOLS, NOT FOUND + CMP (B),SYM + BNE SYMLK2 + CMP 2(B),SYM1 + BNE SYMLK2 + ADD #2,(P) ;SKIP RETURN ON SYMBOL FOUND +SYMLK4: RTS PC + + +;SYFIND LOOKS FOR VALUES IN THE SYMBOL TABLE. ITS FUNCTION IS TO RETURN THE +;SYMBOL WHOSE VALUE EXACTLY MATCHES THE ARGUMENT VALUE. THE ARGUMENT VALUE +;IS EXPECTED IN B. WHEN IT CLZ RETURNS, A POINTS TO THE SYMBOL WHOSE VALUE +;MATCHES, C POINTS TO THE REGISTER WORD FOR THIS SYMBOL, D CONTAINS A 1 +;IN THE BIT POSITION RELEVANT FOR THS SYMBOL. IF FOR SOME REASON, THIS IS +;NOT THE SYMBOL DESIRED, THE SEARCH CAN BE CONTINUED BY RE-ENTERING AT SYFIN1. +SYFIND: MOV #SYMBEG,A ;START OF SYMBOL TABLE + CLR D +SYFIN1: ASL D ;SHIFT THE 1 TO POINT TO THE BIT FOR NEXT SYMBOL + BNE SYFIN2 ;IF WE HAVE NOT REACHED THE END OF 16 SYMBOL BLOCK + TST -(A) ;POINT TO REGISTER WORD FOR NEXT BLOCK + MOV A,C ;SAVE A POINTER TO REGISTER WORD + TST -(A) ;POINT TO HK WORD + INC D ;INITIALIZE THE 1 IN BIT 0 +SYFIN2: SUB #6,A ;ADVANCE TO NEXT SYMBOL + CMP A,SYMEND ;ARE WE AT THE END OF SYMBOLS? + BLO SYFIN3 ;YES, FAIL RETURN + CMP 4(A),B ;DOES THE VALUE OF THIS SYMBOL MATCH ARG VAL + BNE SYFIN1 ;NO, GO TO NEXT SYMBOL + CLZ ;SUCCESS + RTS PC +SYFIN3: SEZ ;FAIL + RTS PC + +SYSNTY: TSTB SYTYRF + BEQ SYSNT1 ;NOT A REGISTER VALUE + JMP RGTYPE ;TYPE AS ABSOLUTE REGISTER +SYSNT1: TSTB SYMADF + BEQ SYSNT2 ;NOT TYPING ADDRESS, TYPE AS SIGNED NUMBER + JMP OTYPE ;TYPING ADDRESS, TYPE AS OCTAL +SYSNT2: JMP NTYPE + + + +;TYPE B AS SYMBOL PLUS OFFSET TYPING UNSIGNED IF NO SYMBOL +ADSYTY: INCB SYMADF + BR SYTYP0 +;TYPE B AS A REGISTER SYMBOL +RSYTYP: INCB SYTYRF + BR SYTYP0 +;TYPE B AS SYMBOL PLUS OFFSET +SYTYPE: CMPB SPACMD,#MPMOD ;ARE WE TRYING TO READ MAP? + BNE SYTYP5 ;NO + JMP NTYPE ;MAP ENTRIES CURRENTLY HAVE NO SYMBOLIC REPRESENTATION +SYTYP5: CMPB SPACMD,#CPMOD ;ARE WE TRYING TO TYPE A CAPABILITY TYPE? + BNE SYTYP6 ;NO + JMP CPTYPE ;FIND A CAPABILITY SYMBOL AND TYPE IT +SYTYP6: CLRB SYMADF + CLRB SYTYRF +SYTYP0: TSTB ABSMD + BNE SYSNTY ;ABSOLUTE MODE, TYPE AS SIGNED NUMBER + CLR SYTYAD + MOV #SYMBEG,A ;WORD AFTER HKILL AND REG WORDS + CLR C ;BEST SYMBOL'S VALUE SO FAR + CLR D +SYTYP1: ASL D + BNE SYTYP2 + TST -(A) ;POINT AT REG WORD + MOV A,E ;SAVE ADDRESS OF REGISTER VALUE WORD + TST -(A) ;POINT AT HALF KILL WORD + INC D +SYTYP2: SUB #6,A ;POINT AT FIRST WORD OF SYMBOL + CMP A,SYMEND + BLO SYTYPX ;OUT OF SYMBOLS + BIT D,-2(E) ;HALF KILLED? + BNE SYTYP1 ;YES + MOV B,F + SUB 4(A),F ;SUBTRACT VALUE OF THIS SYMBOL FROM TARGET + BLO SYTYP1 ;SYMBOL VALUE IS BIGGER THAN UNSIGNED TARGET + CMP F,MXOFF + BHIS SYTYP1 ;SYMBOL IS  100 BELOW TARGET + CMP C,4(A) ;FIND LARGEST SYMBOL BELOW ACTUAL RETAIL B + BHI SYTYP1 ;OLD VALUE (C) WAS BIGGER (BETTER!) + TSTB SYTYRF + BNE SYTYP3 ;NEED TO TYPE REGISTER VALUE + BIT D,(E) ;TYPE NON-REGISTER VALUE, CHECK THIS SYMBOL + BNE SYTYP1 ;SYMBOL IS REGISTER VALUE BUT VALUE ISN'T + BR SYTYP4 ;BOTH NON REGISTER VALUE + +SYTYP3: BIT D,(E) + BEQ SYTYP1 ;VALUE IS REGISTER VALUE BUT SYMBOL ISN'T +SYTYP4: TST (A) ;THIS KEEPS 0 SYMBOLS FROM PRINTING + BNE 1$ ;NOT ZERO + TST 2(A) + BEQ SYTYP1 ;FORGET IT +1$: MOV 4(A),C ;NEW BEST VALUE + MOV A,SYTYAD + BR SYTYP1 + +SYTYPX: TST SYTYAD + BEQ SYTYPW ;NO SYMBOL FOUND, JUST TYPE NUMBER + TSTB SYTYRF + BNE SYTYW3 ;TYPING A REGISTER +SYTYW4: SUB C,B ;GET OFFSET IN B + MOV B,-(P) ;SAVE OFFSET + JSR PC,SYMOUT ;TYPE SYMBOL POINTED TO BY SYTYAD + MOV (P)+,B ;GET OFFSET BACK + BEQ SYTYPZ ;NO OFFSET, JUST EXIT + MOV #'+,A + JSR PC,TYO + JMP NTYPE + +SYTYW3: CMP B,C + BEQ SYTYW4 ;OK IF OFFSET IS ZERO +SYTYPW: TSTB SYTYRF ;TYPE NUMBER, CHECK TO SEE IF IT'S A REGISTER + BEQ SYTYW1 ;NO, TYPE AS UNSIGNED NUMBER + JMP RGTYPE ;TYPE AS PRIMITIVE REGISTER, IE PERMANENT SYMBOL +SYTYW1: JMP NTYPE ;TYPE AS NUMBER IN CURRENT RADIX + +SYTYPZ: RTS PC + +;RGTYPE TYPES THE NAME OF A PRIMITIVE REGISTER, IE A HALFKILLED REGISTER +;WHOSE FIRST CHAR IS %. IN GENERAL, THIS SHOULD ONLY BE THE PERMANENTLY +;DEFINED SYMBOLS. +RGTYPE: SAVE ;GET SOME REGISTERS + JSR PC,SYFIND ;FIND A SYMBOL WHOSE VALUE EQUALS (B) +RGTYP1: BEQ RGTYP3 ;NONE FOUND, TYPE "UNDEFINED" + BIT D,(C) ;IS THE SYMBOL FOUND A REGISTER? + BEQ RGTYP2 ;NO, CONTINUE SEARCHING + BIT D,-2(C) ;IS IT HALF-KILLED? + BEQ RGTYP2 ;NO, CONTINUE SEARCHING + SAVE ;GET SOME REGISTERS + MOV (A),B ;GET FIRST RAD50 WORD OF SYMBOL + CLR A ;FOR DIVIDE + DIV #50*50,A ;GET THE FIRST CHAR + CMP A,#35 ;IS IT % + BEQ RGTYP4 ;YES, SUCCEED + REST ;RESTORE SYFIND ENVIRONMENT +RGTYP2: JSR PC,SYFIN1 ;CONTINUE SEARCH + BR RGTYP1 +RGTYP3: TYPEIT + REST + RTS PC +RGTYP4: REST + MOV A,SYTYAD ;A CONTAINS POINTER TO FIRST RAD50 WORD OF SYMBOL + JSR PC,SYMOUT ;TYPE THE SYMBOL POINTED TO BY SYTYAD + REST + RTS PC + +;CPTYPE TYPES THE SYMBOLIC REPRESENTATION OF A CAPABILITY TYPE. IT LOOKS FOR +;A HALF-KILLED, NON-REGISTER SYMBOL WHOSE FIRST CHAR IS . AND WHOSE LAST 3 +;ARE "CAP". EXPECTS THE VALUE IN B. +CPTYPE: SAVE ;GET SOME REGISTERS + JSR PC,SYFIND ;FIND A SYMBOL WHOSE VALUE EQUALS (B) +CPTYP1: BEQ CPTYP4 ;NONE FOUND, TYPE AS INTEGER + BIT D,-2(C) ;IS IT HALF-KILLED? + BEQ CPTYP2 ;NO, THUS CANNOT BE CAP SYMBOL + BIT D,(C) ;IS IT A REGISTER? + BNE CPTYP2 ;YES, THUS CANNOT BE CAP SYMBOL + CMP 2(A),#11370 ;IS SECOND WORD OF SYMBOL "CAP" IN RADIX 50? + BNE CPTYP2 ;NO, CANNOT BE CAP SYMBOL + SAVE + MOV (A),B ;GET FIRST WORD + CLR A ;FOR DIVIDE + DIV #50*50,A ;GET FIRST CHAR IN A + CMP A,#34 ;IS IT DOT? + BEQ CPTYP3 ;YES, THIS IS THE SYMBOL WE WANT + REST +CPTYP2: JSR PC,SYFIN1 ;CONTINUE SEARCH + BR CPTYP1 +CPTYP3: REST + MOV A,SYTYAD ;USED BY SYMOUT AS POINTER TO SYMBOL + JSR PC,SYMOUT ;TYPE THE SYMBOL + REST + RTS PC +CPTYP4: REST + JMP NTYPE ;IF WE CANNOT FIND SYMBOL, TYPE AS NUMBER + + +;SCTYPE TYPES SYSTEM CALL SYMBOLS INSTEAD OF EMT'S. IT LOOKS FOR A SYMBOL +;WHOSE VALUE EXACTLY MATCHES THE VALUE IN B, AND MAKES SURE THAT THE SYMBOL +;IS HALF-KILLED, IS NOT A REGISTER, AND HAS . AS ITS FIRST LETTER. +SCTYPE: SAVE ;GET SOME REGISTERS + JSR PC,SYFIND ;LOOK FOR A SYMBOL WHOSE VALUE IS B +SCTYP1: BEQ SCTYP4 ;NO SYMBOLS WITH THAT VALUE + BIT D,(C) ;IS THIS A REGISTER SYMBOL? + BNE SCTYP3 ;YES, THUS IT CANNOT BE A SYSTEM CALL + BIT D,-2(C) ;IS IT HALF-KILLED? + BEQ SCTYP3 ;NO, AGAIN NOT AN SC + MOV A,SYTYAD ;ELSE, PRINT THIS SYMBOL. SYMOUT USES THIS LOCATION + JSR PC,SYMOUT ;TYPE SYMBOL + REST ;RESTORE THE WORLD + CLZ ;SUCCEED + RTS PC +SCTYP2: REST ;GO BACK TO THE SYFIND ENVIRONMENT +SCTYP3: JSR PC,SYFIN1 ;CONTINUE SEARCHING FOR SYMBOL + BR SCTYP1 +SCTYP4: REST ;RESTORE THE WORLD + SEZ ;FAIL + RTS PC + +;TYPE SYMBOL POINTED TO BY SYTYAD +SYMOUT: MOV @SYTYAD,B + JSR PC,SYMOU1 + MOV SYTYAD,A + MOV 2(A),B +SYMOU1: CLR A + DIV #50,A + BEQ SYMOU2 + MOV B,-(P) + MOV A,B + JSR PC,SYMOU1 + MOV (P)+,B +SYMOU2: TST B + BEQ SYMOU4 ;FLUSH ZERO + CMP B,#33 + BLT SYMOLT ;LETTER + BEQ SYMODL ;DOLLAR + CMP B,#35 + BEQ SYMOPR ;PERCENT + ADD #22,B ;POINT OR NUMBER +SYMOU3: MOV B,A + JMP TYO + +SYMOU4: JMP SYTYPZ ;TYPE ZERO + +SYMOLT: ADD #100,B + BR SYMOU3 + +SYMODL: MOV #'$,A + JMP TYO + +SYMOPR: MOV #'%,A + JMP TYO + +.SBTTL INTERRUPT LEVEL TTY I/O + +;INT IS THE LOOP FOR THE INTERRUPT LEVEL PROCESS. IT CHECKS CHARS AS THEY +;COME IN AND PROCESSES FUNCTIONS LIKE ^S ^Z AND ^D. IF THE VARIABLE TYOFLS IS +;GREATER THAN ZERO, THEN TYPEOUT WILL BE FLUSHED. IF RESETF IS GREATER THAN +;ZERO, THEN THE INPUT BUFFER WILL BE RESET AS SOON AS THE NEXT CHAR IS READ, +;AND A NEW COMMAND WILL BE READ. + +INT: MOV #INTPDL,P ;RESET THE INTERRUPT PDL + SAVE #TTICAP + .BYTI ;GET A BYTE FROM THE TTY + ERRORB ;FATAL ERROR IF THIS LOSES + MOV (P),A + BIC #177600,A ;FLUSH PARITY ETC. + CMP A,#32 ;IS IT A CONTROL CHAR + BGT INT1 ;NO, JUST GIVE IT TO THE OTHER PROCESS + ASL A ;CONVERT TO WORD INDEX + JSR PC,@CNTLTB(A) ;EXECUTE THE INTERRUPT LEVEL FUNCTION + +INT1: SAVE CLINK + .BYTO ;PUT CHAR IN LINK TO OTHER PROCESS + ERRORB + BR INT ;LOOP FOREVER + +INTSSS: INC TYOFLS ;FLUSH TYOS + INVOK. #TTICAP,#.TTBIS*400,#.TORST ;FLUSH ANYTHING CURRENTLY IN BUF + RTS PC + +INTDDD: INC RESETF ;TELL THE OTHER PROCESS TO QUIT AND GET NEW CMD + RTS PC + +INTZZZ: JSR PC,INTDDD ;QUIT WHAT YOU ARE DOING + JSR PC,INTSSS ;FLUSH ANY TYPEOUT +INTNUL: RTS PC + + + +.SBTTL TYI AND TYO + +;BASIC TTY INPUT ROUTINES +;READ CHARACTER INTO A +TYI: CLR TYOFLS ;SHOULD ALLOW TYPEOUT NOW + TSTB SNEAK1 + BNE TYISN1 ;READ CHAR FROM SNEAK1 + TSTB SNEAK2 + BNE TYISN2 ;READ CHAR FROM SNEAK2 + CMP TYIPNT,CTYIPT ;ARE THERE RUBBED OUT CHARS TO BE REPOSESSED + BEQ TYI1 ;NO, SO GET A NEW CHAR + MOVB @CTYIPT,A ;OTHERWISE, GET CHAR FROM RUBOUT BUFFER + INC CTYIPT ;ADVANCE POINTER TO NEXT CHAR + RTS PC ;SIMPLY RETURN, THESE CHARS HAVE ALREADY BEEN PROCESSED + +TYISN1: MOVB SNEAK1,A ;READ A CHAR FROM SNEAK 1 + CLRB SNEAK1 ;SO WE DO NOT GET IT AGAIN + RTS PC + +TYISN2: MOVB SNEAK2,A ;READ A CHAR FROM SNEAK 2 + CLRB SNEAK2 ;SO WE DO NOT GET IT AGAIN + RTS PC + + +TYI1: SAVE CLINK ;INDEX OF CORE LINK FROM INTERRUPT PROCESS + .BYTI ;GET THE CHAR + ERRORB ;LOSS OF THE TTY IS FATAL + REST A ;PUT THE INPUT CHAR IN A + +TYI3: BIC #177600,A ;CLEAN OFF PARITY ETC + BEQ TYORET ;IGNORE NULLS + CMPB A,#4 ;^D ? + BNE .+6 ;NO + JMP XXXERR ;ABORT THIS COMMAND + CMPB A,#32 ;^Z ? + BNE .+6 ;NO + JMP DDTBRK ;ALSO ABORT + CMPB A,#175 ;CONVERT RIGHT BRACKET TO ESCAPE + BNE TYI4 ;ONLY RUBIN KNOWS WHY + MOV #33,A +TYI4: CMP A,#15 + BEQ TYORET ;DON'T TYPE CR NOW + CMP A,#12 + BEQ TYORET ;DON'T TYPE LF NOW + CMP A,#177 ;CHECK FOR RUBOUT + BNE TYI7 ;NO RUBOUT, JUST NORMAL CHAR + CMP #TYIBUF,TYIPNT ;ELSE SEE IF THERE ARE ANY CHARS TO RUB OUT + BNE .+6 ;YES +TYI6: JMP QERR ;NO, TYPE ? AND GET A NEW COMMAND + DEC TYIPNT ;DELETE A CHAR FROM THE BUFFER + MOVB @TYIPNT,A ;TYPE THE DELETED CHAR + JSR PC,TYO + MOV #TYIBUF,CTYIPT ;RESET POINTER TO THE START OF BUFFER + JMP CMD1 ;RE-EVALUATE THE ENTIRE COMMAND + +TYI7: MOVB A,@TYIPNT ;NORMAL GET GET INSERTED INTO RUBOUT BUFFER + INC TYIPNT ;ADVANCE THE POINTER + CMP TYIPNT,#ETYIBF ;CHECK FOR BUFFER OVERFLOW + BEQ TYI6 ;LOSE VIA JMP QERR + INC CTYIPT ;NOTE THAT BOTH POINTERS ADVANCE TOGETHER +;FALLS THROUGH INTO TYO + + ;TYPE CHARACTER IN A. IGNORE 1S +TYO: BIC #177600,A ;FLUSH PARITY BIT + CMPB A,#40 + BHIS TYOTYP ;TYPE BIGGER THAN 40 AS IS + CMPB A,#11 + BEQ TYOTAB ;TYPE TABS + CMPB A,#33 + BEQ TYOALT ;TYPE $ FOR ALT MODE + CMPB A,#12 + BEQ TYOLF ;TYPE LF AS IS + CMPB A,#15 + BNE TYOCTL ;NOT CR. TYPE OUT ^ FOLLOWED BY UNCONTROLLED CHAR + SAVE A + JSR A,PUTC ;TYPE THE CHAR + CLR CURSOR ;CR CAUSES THE CURSOR TO GO TO COLUMN 0 + RTS PC +TYOTYP: SAVE A ;IT EXPECTS IT + JSR A,PUTC +TYORET: RTS PC + +TYOCTL: SAVE A + MOV #'^,A + JSR A,PUTC ;TYPE ^ FOR CONTROL CHARS + BIS #100,A + JSR PC,TYO ;TYPE AS A NORMAL CHAR + BIC #100,A ;MAKE IT BACK INTO CONTROL CHAR FOR INPUT + RTS PC + +TYOALT: SAVE A + MOV #'$,A ;PRINT A $ FOR ALTMODE + JSR A,PUTC + RTS PC + +TYOTAB: JSR PC,TYOTYP ;TYPE THE TAB + DEC CURSOR ;PUT THE CURSOR BACK + ADD #10,CURSOR ;ADVANCE TO 8 CHAR BOUNDRY + BIC #7,CURSOR ;SITS TTY PROCESSING DOES THE ACTUAL SPACING + RTS PC + +TYOLF: JSR PC,TYOTYP ;TYPE THE LINE FEED + DEC CURSOR ;LF DOES NOT INCREMENT THE CURSOR + RTS PC + +PUTC: TST TYOFLS ;SHOULD WE IGNORE TYPEOUT? + BGT PUTC1 ;YES + SAVE #TTOCAP ;PUSH INDEX TO OUTPUT STREAM CAPABILITY + .BYTO ;TYPE THE CHAR + ERRORB ;CALL SHOULD NOT FAIL + INC CURSOR ;ADVANCE CURSOR + RTS A +PUTC1: TST (P)+ ;POP THE CHAR SINCE BYTO DIDN'T + INC CURSOR ;ADVANCE CURSOR TO NEXT COLUMN + RTS A + +;RESET THE RUBOUT BUFFER +TRESET: MOV #TYIBUF,TYIPNT ;SET THE POINTERS + MOV #TYIBUF,CTYIPT ;TO THE BEGINNING OF THE BUFFER + RTS PC + +;LIKE TYI, EXCEPT PUTS RESULTING CHARACTER IN SNEAK1 +STYI: JSR PC,TYI + MOVB A,SNEAK1 + RTS PC + +;ENABLE TYPEOUT VIA PROCESSING OF ^S + +TYOENB: MOV #23,A ;PUT ^S IN A FOR THE TYO IN FLSDEC + JSR PC,FLSDEC ;DEC FLUSH COUNT AND ENABLE IF 0 + JMP CMD + +FLSDEC: DEC TYOFLS ;STOP FLUSHING TYPEOUT + BGT FLSDE1 ;ONLY RESET TTY STATUS WHEN COUNT REACHES ZERO + INVOK. #TTICAP,#.TTBIC*400,#.TORST ;CLEAR RESET BIT IN TTY STATUS + JSR PC,TYO ;TYPE THE CHAR IN A +FLSDE1: RTS PC + +.IFNZ LSI +TTYWAT: CLR WATJMP + SAVE <#-1,#TTWAT1,#.PRCAP*400> ;CREATE PROCESS FOR 11-LSI COMMUN. + $INVOK ;DONT LOSE + REST A ;SAVE POINTER TO FIRST PROCESS + SAVE <#-1,#TTWAT2,#.PRCAP*400> ;CREATE A PROCESS TO HANDLE LSI-TO-11 COMMUNICATION + $INVOK + REST B ;CAP TO SECOND PROCESS + SAVE <#-1,#4,#.CLCAP*400> ;SET UP CORE LINK FOR COMMUNICATIONS + $INVOK ;AND AGAIN + REST F ;GIVE THIS TO THEM + SAVE <,#-1,F> ;INVOKE IT TO MAKE IT CONSUMER + $INVOK + MOV A,C ;INIT THIS PROCESS + JSR PC,PRSINT + MOV B,C ;NOW THIS ONE + JSR PC,PRSINT + SAVE F ;WAIT FOR THE PROCESSES TO SEND SOMETHING + $BYTI ;TWIDDLE TWIDDLE + JSR PC,DELCP ;DELETE THE WORLD + MOV B,A + JSR PC,DELCP + SAVE <,,#<.SPKIL*400>+MYSPHR> ;KILL ALL PROCESSES + $INVOK + SAVE #INT ;START A NEW INTERRUPT PROCESS + $FORK + MOV F,A + JSR PC,DELCP + TST WATJMP ;BETTER BE SOMETHING HERE + BNE 1$ ;THERE IS + BPT +1$: JMP @WATJMP ;GO TO IT + +PRSINT: SAVE <,C,#MYSPHR+<.SPPTP*400>> ;PUT THE PROCESS INTO THE SPHER + $INVOK + SAVE <,F,C> ;SET HIS REGISTER F TO BE MY REGISTER F + MOVB #.PRREG+5+.PRWRT,1(P) ;WRITE IT + $INVOK + SAVE <,#0,C> ;START THE PROCESS + MOVB #.PRSTOP+.PRWRT,1(P) + $INVOK + RTS PC + +TTWAT2: MOV #WATPDL,P + MOV LSICAP,B ;SAVE SOME TIME + MOV #TTOCAP,C ;DITTO + JSR PC,CRCHK ;WAIT FOR CRLF + BNE TTWAT2 ;LOSE +TTWAT5: JSR PC,NUMMER ;WAIT FOR NUMBER + BEQ TTWAT3 ;GOT IT +TTWAT6: CMP A,#15 ;CR? + BNE TTWAT2 ;NO, FORGET IT + JSR PC,LFCHK ;CHECK FOR LINE FEED + BEQ TTWAT5 ;OKAY, JUST CONTINUE LOOKING FOR NUMBER + BR TTWAT2 ;DIDN'T GET IT +TTWAT3: JSR PC,CRCHK ;WAIT FOR CRLF + BNE TTWAT6 ;CHECK FOR CR + SAVE B ;GET THE LAST BYTE + $BYTI ;GOT IT + SAVE <(P),C> ;COPY IT AND OUTPUT IT TO TTY + $BYTO ;BYE BYE.. + REST A ;GET IT + CMPB A,#'@ ;WAS IT @? + BNE TTWAT6 ;GO BACK FOR MORE + MOV #BPTTRP,WATJMP ;JUMP TO BPTTRP +SELFIM: SAVE <#0,F> ;SAVE CORE LINK CAP + $BYTO ;OUTPUT THE BYTE + SAVE <#40000,#0> ;TAKE A REAL GOOD SNOOZE (REALLY GOING TO BE PUT TO SLEEP) + $SLEEP ;SHOULDN'T FAIL + BPT ;SHOULDN'T GET HERE +CRCHK: SAVE B ;LSI CAP + $BYTI ;GET IT + REST A + JSR PC,WATTYP ;TYPE IT ON THE LOSERS CONSOLE + CMP A,#15 ;CR? + BNE LFCHK1 ;NO LOSE +LFCHK: SAVE B + $BYTI + REST A ;GET CHAR + CMP A,#12 ;LINE FEED? +LFCHK1: RTS PC + + +WATTYP: SAVE ;THE BYTE AND TTYCAP + $BYTO + RTS PC + +NUMMER: MOV #6,E ;NUMBER OF NUMBERS IN A NUMBER +NUMLP: SAVE B ;LSI CAP + $BYTI ;GET POTENTIAL NUMBER + REST A + JSR PC,WATTYP + CMP A,#'0 ;IS IT A NUMBER + BLO NUMR1 ;NOPE + CMP A,#'7 ;ODT ONLY USES OCTAL + BHI NUMR1 ;TO BIG + SOB E,NUMLP ;UNTIL WE FINISH + SEZ + RTS PC +NUMR1: CLZ + RTS PC + +TTWAT1: MOV #MPDL,P ;SET UP P +TTLOP1: SAVE CLINK ;GET A CHARACTER + $BYTI + REST A ;THE CHARACTER + BIC #177600,A ;CLEAR CRUFT + CMP A,#4 ;^D? + BNE 1$ ;YES + MOV #XXXERR,WATJMP ;SAY WE SHOULD JUMP TO XXXERR + JMP SELFIM ;GO IMMOLATE YOURSELF +1$: CMP A,#32 ;CONTROL Z? + BNE TWAIT2 ;NO + MOV #DDTBRK,WATJMP ;SAY WE SHOULD JUMP TO DDTBRK + JMP SELFIM +TWAIT2: SAVE ;OUTPUT IT TO THE LSI + $BYTO + BR TTLOP1 ;GOOD BYE +.ENDC + +.SBTTL STRING TYPIN, STRING AND NUMBER TYPEOUT + +;GETLIN,TYPE AND TYPIT +;LINE INPUT AND MESSAGE TYPEOUT ROUTINES + +;READ A LINE FROM TTY INTO THE STRING BUFFER +;RETURN WITH Z CLEAR IF ANYTHING TYPED BEFORE +;AFTER LAST CHAR THERE IS A ZERO IN THE BUFFER +;D POINTS TO LAST CHAR IN THE BUFFER +GETLIN: MOV #STRBUF,E + MOV E,D ;SAVE IT IN B + MOV #SBFLEN-1,C ;LENGTH OF BUFFER-1 +GETLI3: JSR PC,TYI ;GET A NON-RUBOUT +GETLI7: CMP #15,A ;RETURN? + BEQ GETLI2 + MOVB A,(D)+ ;SAVE THE CHARACTER + SOB C,GETLI3 + TYPEIT +GETLI4: JSR PC,TYI ;GET A NON-RUBOUT + CMP #15,A + BEQ GETLI2 + TST C ;DID HE RUBOUT? + BNE GETLI3 + BR GETLI4 +GETLI2: JSR PC,CRLF + CLRB (D) + CMP D,E ;WAS ANYTHING TYPED? + RTS PC + +TYPIT: SAVE B + MOV A,B ;COPY POINTER +TYPIT1: MOVB (B)+,A ;GET THE BYTE + BEQ 1$ ;DONE + JSR PC,TYO ;OUTPUT IT + BR TYPIT1 +1$: MOV B,A ;COPY BACK POINTER + REST B + RTS PC + +TYPSTR: SAVE ;GET SOME REGISTERS + MOV 6(P),B ;POINTER TO THE STRING +TYPST1: MOVB (B)+,A ;GET THE BYTE + BEQ 1$ ;DONE + JSR PC,TYO ;OUTPUT IT + BR TYPST1 +1$: REST ;THE REGISTERS BACK + MOV (P)+,(P) ;CRUSH POINTER + RTS PC + +;SETCUR TYPES SPACES TO MOVE THE CURSOR TO A SPECIFIED COLUMN. IF THE CURSOR +;IS ALREADY PAST THAT COLUMN, IT DOES A CRLF FIRST. EXPECTS COLUMN NUMBER IN B. +SETCUR: CMP CURSOR,B + BEQ SETCU2 ;IF CURSOR EQUALS COLUMN, THEN DONE + BLT SETCU1 ;IF CURSOR IS PAST THAT COLUMN, DO A CRLF FIRST + JSR PC,CRLF +SETCU1: MOV #40,A + JSR PC,TYO ;TYPE A SPACE + BR SETCUR ;LOOP UNTIL CURSOR EQUALS COLUMN. +SETCU2: RTS PC + ;CRLF, CRLFS, DTYPE, OTYPE, NTYPE, SNTYPE + +CRLF: TYPEIT ^/î/ + RTS PC + +CRLFS: TYPEIT ^/î*/ + RTS PC + +;TYPE DECIMAL INTEGER IN B +DTYPE: MOV C,-(P) + MOV #10.,C + JSR PC,RTYPE +DTYPEX: MOV (P)+,C + RTS PC + +RTYPE: CLR A + DIV C,A + BEQ DTYPE1 + MOV B,-(P) + MOV A,B + JSR PC,RTYPE + MOV (P)+,B +DTYPE1: MOV B,A + JMP NTYO + +;TYPE B IN OCTAL +OTYPE: MOV C,-(P) + MOV #10,C + JSR PC,RTYPE + BR DTYPEX + +;TYPE B AS SIGNED 16 BIT NUMBER +SNTYPE: TST B + BPL NTYPE + MOV #'-,A + JSR PC,TYO + NEG B +NTYPE: TSTB DECMD + BEQ OTYPE + JSR PC,DTYPE + MOV #'.,A + JMP TYO + + +;ZTYPE PRINTS DECIMAL INTEGER IN B, WITH LEADING 0 IF <10 +ZTYPE: MOV A,-(P) ;SAVE A + CLR A + DIV #10.,A ;QUOTIENT IN A; REMAINDER IN B + JSR PC,NTYO ;PRINT QUOTIEN IN A (10'S DIGIT) + MOV B,A + JSR PC,NTYO ;PRINT REMAINDER IN A (1'S DIGIT) + MOV (P)+,A ;RESTORE A + RTS PC + + + + ;FTYPE TYPE AC0 AS FLOATING POINT + +;TYPE FLOATING VALUE IN AC0 IN APPROPRIATE PRECISION +FTYPE: MOVB #16.,FDIGCT ;DIGIT COUNTER + TSTB DBLFMD + BNE FTYPDP + MOVB #8,FDIGCT ;SINGLE PRECISION +FTYPDP: CLR POWER + TSTD AC0 + CFCC + BEQ FTYP1A ;TYPE 0.0 + BPL FTYPE1 + MOV #'-,A + JSR PC,TYO + ABSD AC0 +FTYPE1: CMPD DTENTH,AC0 + CFCC + BGT FTYPE2 ;BRANCH IF NUMBER IS LT 0.1 + CMPD DBIG,AC0 + CFCC + BLE FTYPE3 ;BRANCH IF NUMBER IS  10^16 +FTYPE5: MODD D1,AC0 ;AC1_INTEGER PART, AC0_DECIMAL PART + TSTD AC1 + CFCC + BEQ FTYP1A ;ZERO INTEGER PART + LDD AC1,AC2 + JSR PC,FTYPDC ;TYPE AC2 AS DECIMAL +FTYDPT: MOV #'.,A + JSR PC,TYO + TSTB FDIGCT + BEQ FTYDP1 ;OUT OF DIGITS, TYPE A 0 FOR THE DECIMAL PART +FTYPE4: MODD D10,AC0 ;TYPE DECIMAL PART FROM AC0 + STCDI AC1,A + JSR PC,NTYO ;TYPE THE DIGIT + TSTD AC0 + CFCC + BEQ FTYPEX ;ZERO DECIMAL PART + DECB FDIGCT + BNE FTYPE4 + BR FTYPEX + +FTYDP1: JSR PC,TYO0 +FTYPEX: TSTB POWER + BEQ FTYRET ;NO EXPONENT TO TYPE + TSTB POWER+1 + BNE FTYPX1 + TYPEIT E- + BR FTYPX2 +FTYPX1: TYPEIT E+ +FTYPX2: MOVB POWER,B + JMP DTYPE ;TYPE THE EXPONENT + +FTYRET: RTS PC + +FTYP1A: JSR PC,TYO0 ;TYPE A ZERO + BR FTYDPT + +FTYPDC: LDD AC2,AC1 + MODD DTENTH,AC2 ;AC3_INTEGER PART/10 + LDD AC3,AC2 ;VALUE FOR NEXT CALL ON FTYPDC + CFCC + BEQ FTYPD1 + MULD D10,AC3 + SUBD AC3,AC1 ;LEAST SIGNIFICANT DIGIT + STCDI AC1,-(P) ;PUSH DIGIT + JSR PC,FTYPDC + MOV (P)+,A ;GET DIGIT BACK +FTYPD2: DECB FDIGCT +NTYO: ADD #'0,A ;CONVERT TO CHAR CODE + JMP TYO + +FTYPD1: STCDI AC1,A + BR FTYPD2 + +TYO0: CLR A + BR NTYO + +;TYPE AS EITHER 0.XXXE-NN OR X.XXXXE+NN +FTYPE3: INCB POWER+1 ;INDICATE 10^16 +FTYPE2: STD AC0,FTEMP + MOV FTEMP,A + MUL #154.,A ;154/512 = .301 + SUB #38.,A ;THIS IS APPROXIMATELY THE POWER OF TEN + MOV A,B + BGE FTYP2A + NEG B +FTYP2A: MOVB B,POWER + ASH #3,A + NEG A + MULD DTENTB(A),AC0 ;TRY TO SCALE TO 10^0 +FTYP2C: STD AC0,AC2 + MODD D1,AC2 + STCDI AC3,A ;INTEGER PART + CMP A,#9 + BGT FTYP2D ;TOO BIG + TST A + BEQ FTYP2E ;DECIMAL PART IS ZERO + TSTB POWER+1 + BNE FTYPE5 ;TYPE THE NUMBER NOW +FTYP2D: MULD DTENTH,AC0 + INCB POWER + BR FTYP2C + +FTYP2E: TSTB POWER+1 + BEQ FTYP2F +FTYP2G: MULD D10,AC0 + DECB POWER + BR FTYP2C + +FTYP2F: CMPD DTENTH,AC0 + CFCC + BGT FTYP2G + BR FTYPE5 ;TYPE THE NUMBER NOW + +PATCH: +PAT: .BLKW 40 + -1 ;MAKE SURE CORE CREATED FOR WHOLE PATCH AREA +INSEND==<.+1777-PURINS>/2000 ;THE END OF THE INS. PAGE ROUNDED TO A BLOCK +.IIF GT .-PAG3A,.ERROR PROGRAM AREA OVERFLOW + +.=PURVAR ;PURE VARIABLES +.IFNZ LSI +;HERE LIES THE RESIDENT PORTION OF THE LSI DDT..... +LSIBOT: BIC #20,2(P) ;CLEAR THE TRAP BIT +LSIHLT: HALT ;RETURN TO CONSOLE MICRO CODE + BIS #20,2(P) ;SET THE TRAP BIT +LSIGO: SUB #2,(P) ;FIX PC TO POINT TO PREVIOUS LOCATION + ;THIS BACKS UP OVER PREVIOUS BPT +LSTINS: RTT ;THIS SITS IN THE TOP LOCATION OF CORE + +BPTOFF==LSTINS-LSIHLT-2 ;HALTS WITH PC POINTING TO NEXT INS +RESOFF==LSTINS-LSIBOT ;DEFINE THE OFFSET FROM THE TOP OF CORE +GOOFF==LSTINS-LSIGO ;WHERE TO START IT FOR $P +.ENDC + +;EVLTB OPERATOR EVALUATION DIPATCH TABLE +EVLTB: EPLUS + EMINUS + ESTAR + EQUOT + 0 + ECOMMA + +;DISPATCH TABLE TO PRINT THE VARIOUS ENTRY TYPES +PRENTB: PRNAER ;0 PARENT + PRDENT ;2 DIRECTORY + PRFENT ;4 FILE + PRFENT ;6 LAST FILE + PRNAER ;10 SELF + PRNAER ;12 LINK + PRNAER ;14 UNUSED + PRNAER ;16 UNUSED + +CCINTB: .BYTE 'C,'V,'Z,'N + +;MACROS TO DEFINE THE FAULT SYMBOL TABLE +.MACRO DFAULT VALUE,SYM1,SYM2 + .WORD VALUE + .RAD50 /SYM1/ +.IF NB SYM2 + .RAD50 /SYM2/ +.IFF + .RAD50 // +.ENDC +.ENDM + +;THE LAST ENTRY IN FAULT TABLE HAS A VALUE OF 0 AND SYMBOL IS "UNK" +FLTTB: DFAULT .BETF,BET ;BUSS ERROR TRAP + DFAULT .ILLTF,ILL ;ILLEGAL INSTRUCTION TRAP + DFAULT .BPTTF,BPT ;BPT TRAP + DFAULT .IOTTF,IOT ;IOT TRAP + DFAULT .EMTTF,EMT ;BAD EMT TRAP + DFAULT .TRPTF,TRP ;TRAP TRAP (NO TRAP THROUGH ENABLED) + DFAULT .FPPTF,FPP ;FLOATING POINT EXCEPTION TRAP + DFAULT .SLETF,SLE ;SEGMENT LENGTH ERROR TRAP + DFAULT .RDOTF,RDO ;READ ONLY SEGMENT VIOLATION TRAP + DFAULT .NXMTF,NXM ;NON EXISTANT PAGE TRAP + DFAULT 0,UNK ;UNKNOWN TRAP TYPE +;CONTROL CHAR INTERRUPT LEVEL DISPATCH TABLE + +CNTLTB: +.REPT 4 + INTNUL ;^@-^C DO NOTHING +.ENDR + INTDDD ;^D GET NEW COMMAND +.REPT 14. + INTNUL ;^E-^R DO NOTHING +.ENDR + INTSSS ;^S FLUSH TYPEOUT +.REPT 6 + INTNUL ;^T-^Y DO NOTHING +.ENDR + INTZZZ ;^Z BREAK DDT + +.SBTTL COMMAND TABLES + +.MACRO DEFFNC NAME,ROUTINE +CMDCNT==CMDCNT+1 +TEXTLN==TEXTLN+.LENGTH ^ÎAME¬+1 +.IF2 +.=P1 +P3 +.=P2 +.WORD ROUTINE +P2==P2+2 +.=P3 +.ASCIZ ÎAMEŠ P3==. +P1==P1+2 +.ENDC +.ENDM + +CMDCNT==0 ;NO COMMANDS YET +P1=. ;START DEFINING THEM HERE +TEXTLN==0 ;THE TOTAL LENGTH OF THE TEXT + +.IF2 ;ON THE FIRST PASS, JUST RESERVE THE SPACE +P2==CCMDTB ;THE ROUTINE ADDRESSES IN CCMDTB +P3==CNAMES ;THE NAMES IN CNAMES +.ENDC + + +;DEFINE THE COLON COMMANDS. +CNAMTB=. ;THIS IS THE LOCATION OF CNAMTB + +DEFFNC PUNCH,PUNCH +DEFFNC SYMADD,SYMADD +DEFFNC NEWSPH,CLOAD +DEFFNC LISTF,PRDIR +DEFFNC DELETE,DELFIL +DEFFNC PRINT,PRFILE +DEFFNC YANK,A1YANK +DEFFNC PDUMP,PDUMP +DEFFNC LOAD,LOAD +DEFFNC BINLOAD,BINLOD +DEFFNC SSTAT,STATUS +DEFFNC FONT,FONT +DEFFNC CAPMODE,CAPMOD +DEFFNC MAPMODE,MAPMOD +DEFFNC SYSMODE,SYSMOD +DEFFNC CLEARSCREEN,CS +DEFFNC REVERSE,REV +DEFFNC ISPACE,ISPACE +DEFFNC ?,QUEST +DEFFNC SETD,SETDEF +DEFFNC LOGOUT,LOGOUT +DEFFNC DSPACE,DSPACE +DEFFNC COPY,COPY +DEFFNC ERROR,PRERR +.IIF NZ LSI,DEFFNC LSI,LSIDDT +.IIF NZ LSI,DEFFNC SITS,SITDDT +.=CNAMTB ;SET IT BACK TO CNAMTB +TEXTLN==</2> ;ROUND IT UP TO WORD BOUNDARY, AND GET NUMBER OF WORDS +;DEFINE THE TABLES +CNAMTB: +.=.+2+ ;SAVE NUMBER OF COMMANDS OF WORDS, PLUS ONE OF ZERO AT END +CCMDTB: +.=.+<2*CMDCNT> ;SAVE NUMBER OF COMMANDS OF WORDS +CNAMES: +.=.+<2*TEXTLN> ;SAVE RIGHT NUMBER OF BYTES OF DATA +LASTCC: + +.MACRO ERR NAME,STRING +ERRNUM==ERRNUM+1 +ASCLEN==ASCLEN+.LENGTH ^ÓTRING¬+1 +.IF2 +FOO==. +.=ERRTAB+<.E'NAME'*2> +ASCLOC +.=ASCLOC +.ASCIZ ÓTRINGŠ ASCLOC==. +.=FOO +.ENDC +.ENDM +ERRNUM==0 ;REINIT THE COUNTER + +ERRTAB: + +ERR NUL, +ERR APEF, +ERR BAC, +ERR BAD, +ERR BCN, +ERR BCT, +ERR BFN, +ERR BFUN, +ERR BPN, +ERR CDD, +ERR DEVE, +ERR DFL, +ERR DRF, +ERR EAE, +ERR FLOK, +ERR FNF, +ERR FNTL, +ERR FTL, +ERR NIS, +ERR NIT, +ERR NSS, +ERR RNA, +ERR RPEF, +ERR SYS, +ERR CLF, +.=ERRTAB+ + +;CMDTB, POPTB, ALTTB + +;DEFINE LIST OF SEPARATOR CHARACTERS. THE ARGUMENTS TO X +;ARE THE DIPATCH ADDRESS, FLAG FOR POPPING OP STACK, FLAG +;FOR LEGAL IN INSTRUCTION TYPEIN +.MACR CMDS + X QERR,,INILL ;0 ^@ + X SYMADD,,INILL ;1 ^A + X QERR,,INILL ;2 ^B + X CLOAD,,INILL ;3 ^C + X XXXERR,,INILL ;4 ^D + X QERR,,INILL ;5 ^E + X PRDIR,POP,INILL ;6 ^F + X QERR,,INILL ;7 ^G + X QERR,,INILL ;10 ^H + X ATAB,POP,INSEP ;11 JTAB + X ALF,POP,INSEP ;12 LINE FEED + X QERR,,INILL ;13 ^K + X CS1,,INILL ;14 ^L + X ACR,POP,INSEP ;15 CARRIAGE RETURN + X ASSTEP,POP,INILL ;16 ^N + X DELFIL,,INILL ;17 ^O + X BRKPRO,POP,INILL ;20 ^P + X A2PROQ,POP,INILL ;21 ^Q + X PRFILE,,INILL ;22 ^R + X TYOENB,,INILL ;23 ^S +.REPT 4 + X QERR,,INILL ;24-27 ^T-^W +.ENDR + X ASSTEP,POP,INILL ;30 ^X + X QERR,,INILL ;31 ^Y + X DDTBRK,,INILL ;32 ^Z + X AALT,,INSEP ;33 ALT MODE +.REPT 4 + X QERR,,INILL ;34-37 +.ENDR + X AP,,INOK ;40 SPACE + X AQUOT,,INOK ;41 ! + X ADQUO,,INOK ;42 " + X QERR,POP,INILL ;43 # + X QERR,,INILL ;44 $ + X QERR,,INILL ;45 % + X AAMPR,,INOK ;46 & + X ASQUO,,INOK ;47 ' + X ALPAR,,INOK ;50 ( + X ARPAR,,INOK ;51 ) + X ASTAR,,INOK ;52 * + X APLUS,,INOK ;53 + + X ACOMMA,POP,INSEP ;54 , + X AMINUS,,INOK ;55 - + X QERR,,INILL ;56 . + X ASLASH,POP,INILL ;57 / +.REPT 10. + X QERR,,INILL ;60-71 0-9 +.ENDR + X ACOLN,,INILL ;72 : + X QERR,POP,INILL ;73 ; + X ALESS,POP,INILL ;74 < + X AEQUL,POP,INSEP ;75 = + X AGREAT,POP,INILL ;76 > + X QERR,,INILL ;77 ? + X AAT,POP,INSEP ;100 @ +.REPT 26. + X QERR,,INILL ;101-132 A-Z +.ENDR + X ALBRK,POP,INSEP ;133 [ + X ABACK,POP,INSEP ;134 \ + X QERR,,INSEP ;135 ] + X AUARR,POP,INSEP ;136 ^ + X ALARR,POP,INSEP ;137 _ +.REPT 40 + X QERR,,INILL ;140-177 +.ENDR +.ENDM + +.MACR X A,B,C + A +.ENDM +CMDTB: CMDS + +.MACR X A,B,C +.IFNB B + .BYTE 1 +.ENDC +.IFB B + .BYTE 0 +.ENDC +.ENDM +POPTB: CMDS + .EVEN + +.MACR X A,B,C +.IF IDN C,INSEP + .BYTE 1 +.ENDC +.IF IDN C,INILL + .BYTE -1 +.ENDC +.IF IDN C,INOK + .BYTE 0 +.ENDC +.ENDM +INLTB: CMDS + .EVEN + + .MACR ALTS + X A1ABS,A2ABS ;A + X A1BRK,A2BRK ;B + X A1CNST,A2CNST ;C + X A1DEC,A2DEC ;D + X A1EFF,A1EFF ;E + X A1FLT,A2FLT ;F + X A1GO,A2GO ;G + X A1HALF,A2HALF ;H + X A1INST,A2INST ;I + X QERR,QERR ;J + X A1HK,A2SYKL ;K + X LOAD,LOAD ;L + X A1MASK,A1MASK ;M + X A1NOT,A1NOT ;N + X A1OCT,A2OCT ;O + X A1PRO,A2PRO ;P + X A1Q,A1Q ;Q + X A1REL,A2REL ;R + X A1SYMB,A2SYMB ;S + X A1TXT,A2TXT ;T + X QERR,LOGOUT ;U + X A1FLTI,A2FLTI ;V + X A1WORD,A1WORD ;W + X A1XCT,A1XCT ;X + X A1YANK,PDUMP ;Y + X A1ZERO,A2ZERO ;Z +.ENDM + +.MACR X A,B + A +.ENDM + +ALTTB: ALTS + +.MACR X A,B + B +.ENDM + +ALT2TB: ALTS + + .MACR CALTS + X A1SYS,A2SYS ;A + X A1BYTE,A2BYTE ;B + X A1CAPS,A2CAPS ;C + X QERR,QERR ;D + X QERR,QERR ;E + X QERR,QERR ;F + X QERR,QERR ;G + X QERR,QERR ;H + X A1IPC,A2IPC ;I + X QERR,QERR ;J + X QERR,QERR ;K + X QERR,QERR ;L + X QERR,QERR ;M + X QERR,QERR ;N + X QERR,QERR ;O + X A1DBL,A2DBL ;P + X QERR,QERR ;Q + X QERR,QERR ;R + X QERR,QERR ;S + X QERR,QERR ;T + X A1UPT,A2UPT ;U + X QERR,QERR ;V + X A1DPC,A2DPC ;W + X QERR,QERR ;X + X QERR,QERR ;Y + X QERR,QERR ;Z +.ENDM + +.MACRO X A,B + A +.ENDM + +ACTLTB: CALTS + +.MACRO X A,B + B +.ENDM + +ACT2TB: CALTS + + +.SBTTL CONSTANTS +.NLIST +;DTENTB POWERS OF TEN + +DM38: .WORD 531,143734,166523,143440 ;10^-38 + .WORD 1410,16352,12124,56164 + .WORD 2252,22044,114551,71621 + .WORD 3124,126455,137703,150166 + .WORD 4004,166074,113732,61112 + .WORD 4646,23513,136720,175334 + .WORD 5517,130436,126505,34623 + .WORD 6401,147263,26113,41774 + .WORD 7242,41137,173536,12373 + .WORD 10112,151367,172465,115072 + .WORD 10775,103665,171203,312 + .WORD 11636,72321,133621,160176 + .WORD 12506,11006,22566,54236 + .WORD 13367,113207,127323,167305 + .WORD 14232,137024,146504,72474 + .WORD 15101,66632,225,111212 + .WORD 15761,144400,100272,173455 + .WORD 16627,16640,50164,155174 + .WORD 17474,162410,62222,10433 + .WORD 20354,17112,76666,112542 + .WORD 21223,111356,107222,16535 + .WORD 22070,73652,31066,122265 + .WORD 22746,112624,137304,46742 + .WORD 23620,16574,173472,130255 + .WORD 24464,22334,32411,56330 + .WORD 25341,27023,41113,132016 + .WORD 26214,136314,4557,50211 + .WORD 27057,165777,5713,22253 + .WORD 27733,163376,147275,166726 + .WORD 30611,70137,40466,132246 + .WORD 31453,146167,10604,60717 + .WORD 32326,137624,152745,75103 + .WORD 33206,33675,2657,66152 + .WORD 34047,142654,43433,43604 + .WORD 34721,133427,54342,14545 + .WORD 35603,11156,113615,47737 + .WORD 36443,153412,36560,121727 +DTENTH: .WORD 37314,146314,146314,146315 +D1: +DTENTB: .WORD 40200,0,0,0 +D10: .WORD 41040,0,0,0 + .WORD 41710,0,0,0 + .WORD 42572,0,0,0 + .WORD 43434,40000,0,0 + .WORD 44303,50000,0,0 + .WORD 45164,22000,0,0 + .WORD 46030,113200,0,0 + .WORD 46676,136040,0,0 + .WORD 47556,65450,0,0 + .WORD 50425,1371,0,0 + .WORD 51272,41667,40000,0 + .WORD 52150,152245,10000,0 + .WORD 53021,102347,25000,0 + .WORD 53665,163040,172200,0 + .WORD 54543,57651,30640,0 +DBIG: .WORD 55416,15711,137404,0 ;10^16 + .WORD 56261,121274,27305,0 + .WORD 57136,5553,35166,40000 + .WORD 60012,143443,2211,164000 + .WORD 60655,74353,142654,61000 + .WORD 61530,153446,133427,75200 + .WORD 62407,103170,31156,126220 + .WORD 63251,64026,37412,53664 + .WORD 64123,141033,147314,166641 + .WORD 65004,54521,60500,12205 + .WORD 65645,67645,134620,14646 + .WORD 66516,145617,23764,20020 + .WORD 67401,37471,74370,112012 + .WORD 70241,107407,153466,134415 + .WORD 71111,171311,146404,63520 + .WORD 71774,67574,40105,100444 + .WORD 72635,142655,124053,70267 + .WORD 73505,33431,11066,46345 + .WORD 74366,102337,53303,160036 + .WORD 75232,11413,113072,66023 + .WORD 76100,113716,75711,3430 + .WORD 76760,136702,15273,44336 + .WORD 77626,73231,50265,6613 ;10^38 + ;OPCTB OP CODES + +OPCTB: +;SINGLE OPERAND INSTRUCTIONS nnnnDD or nnnnSS + OPBLK SOPIN,SOPOUT,000077 + DEFOP JMP,000100 + DEFOP SWAB,000300 + DEFOP CLR,005000 + DEFOP COM,005100 + DEFOP INC,005200 + DEFOP DEC,005300 + DEFOP NEG,005400 + DEFOP ADC,005500 + DEFOP SBC,005600 + DEFOP TST,005700 + DEFOP ROR,006000 + DEFOP ROL,006100 + DEFOP ASR,006200 + DEFOP ASL,006300 + DEFOP MFPI,006500 + DEFOP MTPI,006600 + DEFOP SXT,006700 + DEFOP CLRB,105000 + DEFOP COMB,105100 + DEFOP INCB,105200 + DEFOP DECB,105300 + DEFOP NEGB,105400 + DEFOP ADCB,105500 + DEFOP SBCB,105600 + DEFOP TSTB,105700 + DEFOP RORB,106000 + DEFOP ROLB,106100 + DEFOP ASRB,106200 + DEFOP ASLB,106300 + DEFOP MFPD,106500 + DEFOP MTPD,106600 + +;DOUBLE OPERAND INSTRUCTIONS nnSSDD + OPBLK DOPIN,DOPOUT,007777 + DEFOP MOV,010000 + DEFOP CMP,020000 + DEFOP BIT,030000 + DEFOP BIC,040000 + DEFOP BIS,050000 + DEFOP ADD,060000 + DEFOP MOVB,110000 + DEFOP CMPB,120000 + DEFOP BITB,130000 + DEFOP BICB,140000 + DEFOP BISB,150000 + DEFOP SUB,160000 + +;BRANCHES n nnn nnn nxx xxx xxx + OPBLK BRIN,BROUT,000377 + DEFOP BR,000400 + DEFOP BNE,001000 + DEFOP BEQ,001400 + DEFOP BGE,002000 + DEFOP BLT,002400 + DEFOP BGT,003000 + DEFOP BLE,003400 + DEFOP BPL,100000 + DEFOP BMI,100400 + DEFOP BHI,101000 + DEFOP BLOS,101400 + DEFOP BVC,102000 + DEFOP BVS,102400 + DEFOP BCC,103000 + DEFOP BHIS,103000 + DEFOP BCS,103400 + DEFOP BLO,103400 + +;REGISTER - DESTINATION nnnrDD + OPBLK RDIN,RDOUT,000777 + DEFOP JSR,004000 + DEFOP XOR,074000 + +;REGISTER - SOURCE nnnrSS + OPBLK RSIN,RSOUT,000777 + DEFOP MUL,070000 + DEFOP DIV,071000 + DEFOP ASH,072000 + DEFOP ASHC,073000 + +;SOB 077rnn + OPBLK SOBIN,SOBOUT,000777 + DEFOP SOB,077000 + +;MISCELLANEOUS - NO OPERAND + OPBLK MSCIN,INRET,000000 + DEFOP HALT,0 + DEFOP WAIT,1 + DEFOP RTI,2 + DEFOP BPT,3 + DEFOP IOT,4 + DEFOP RESET,5 + DEFOP RTT,6 + +;MISCELLANEOUS - NO OPERAND n nnn nxx xxx xxx + OPBLK MS2IN,MS2OUT,000377 + DEFOP EMT,104000 + DEFOP TRAP,104400 + +;RTS 00020r + OPBLK RTSIN,RTSOUT,000007 + DEFOP RTS,000200 + +;PL 00023n + OPBLK PLIN,PLOUT,000007 + DEFOP PL,000230 + +;MARK 0064nn + OPBLK MRKIN,MRKOUT,000077 + DEFOP MARK,006400 + +;CONDITION CODE 0002 1sn zvc + OPBLK CCIN,CCOUT,000017 + DEFOP CL,000240 + DEFOP SE,000260 + +;FLOATING POINT INSTRUCTIONS +;MISCELLANEOUS + OPBLK SOPEX,FMOUT,000000 + DEFOP CFCC,170000 + DEFOP SETF,170001 + DEFOP SETI,170002 + DEFOP SETD,170011 + DEFOP SETL,170012 + +;ONE OPERAND nnnnSS or nnnnDD + OPBLK SOPIN,FSOOUT,000077 + DEFOP LDFPS,170100 + DEFOP STFPS,170200 + DEFOP STST,170300 + DEFOP CLRF,170400 + DEFOP CLRD,170400 + DEFOP TSTF,170500 + DEFOP TSTD,170500 + DEFOP ABSF,170600 + DEFOP ABSD,170600 + DEFOP NEGF,170700 + DEFOP NEGD,170700 + +;FSRC - AC n nnn nnn naa SS + OPBLK FSAIN,FSAOUT,000377 + DEFOP MULF,171000 + DEFOP MULD,171000 + DEFOP MODF,171400 + DEFOP MODD,171400 + DEFOP ADDF,172000 + DEFOP ADDD,172000 + DEFOP LDF,172400 + DEFOP LDD,172400 + DEFOP SUBF,173000 + DEFOP SUBD,173000 + DEFOP CMPF,173400 + DEFOP CMPD,173400 + DEFOP DIVF,174400 + DEFOP DIVD,174400 + DEFOP LDCFD,177400 + DEFOP LDCDF,177400 + +;SRC - AC n nnn nnn naa SS + OPBLK FSAIN,SRAOUT,000377 + DEFOP LDEXP,176400 + DEFOP LDCIF,177000 + DEFOP LDCID,177000 + DEFOP LDCLF,177000 + DEFOP LDCLD,177000 + +;AC - FDST n nnn nnn naa DD + OPBLK AFDIN,AFDOUT,000377 + DEFOP STF,174000 + DEFOP STD,174000 + DEFOP STCFD,176000 + DEFOP STCDF,176000 + +;AC - DST n nnn nnn naa DD + OPBLK AFDIN,ADSOUT,000377 + DEFOP STEXP,175000 + DEFOP STCFI,175400 + DEFOP STCDI,175400 + DEFOP STCFL,175400 + DEFOP STCDL,175400 + + 0 ;NEW BLOCK + 0 ;END OF LIST +.LIST +XCTSYM: .RAD50 /%CS/ ;SEARCH FOR THIS LOCATION TO WRITE XCT INSTRUCTION + .RAD50 /X/ + +ASCBUF: +.=.+ASCLEN ;ALLOCATE THE AREA FOR ASCII STRINGS +.IIF LT PURVAR+20000-.,.ERROR OVERFLOW OF PURE VARIABLE PAGE +PURLEN==<.+1777-PURVAR>/2000 ;GET THE LENGTH OF THE PURE VARIABLE PAGE +.END DDT