ߋtv ?B-NO BOOT ON VOLUME @w p@w wP׭ ׭ w f& fwW#w v   @ @wP  @& 7 "  BLOCK@   IS BAD   -̂@ &   # p@ zw 7 P7 R & B g wD ѕ  Rì     s   p x] \Z 1  d s  -2&w* }kQ.s kQ .spkQ .q@^kQ .s˖kQ* . gkQ.f:dkQ .fpkQ .f˖kQ .C>C>C>C>C>C>C>C>C>C NODISP=1 ;DISABLE DISPLAY SUPPORT .ENDC ;<<<<<<<<<<<<<<<<<<<< ; ; ; THE ASSEMBLY PARAMETER 'NODISP' MUST BE UNDEFINED ; AT ASSEMBLY TIME TO PRODUCE THE DISPLAY MONITOR VERSION ; OF THE EDITOR. THE EDITOR SOURCE MUST BE ASSEMBLED ; WITH VTMAC, THE GRAPHICS MACRO LIBRARY. LINKING ; IS DONE WITH VTCED1, VTCED4, AND VTBEDT, ; SMALLER VERSIONS OF THE DISPLAY FILE HANDLER ; MODULES VTCAL1, VTCAL4, AND VTBASE, RESPECTIVELY. ; LINK COMMAND STRING IS: ; EDIT=VTCED1,VTCED4,VTBEDT,EDIT ; ; DISPLAY EDITOR VERSION BY D. VELTEN ; ENHANCEMENTS TO DISPLAY EDITOR BY BRUCE LEAVITT ; COMMONLY USED SYMBOLS FOR ASCII CHARACTERS LF=12 FF=14 CR=15 MINUS=55 PLUS=53 SLASH=57 SPACE=40 ALTMDE=33 LBRCKT=74 RBRCKT=76 QMARK=77 ZERO=60 NINE=71 E=105 M=115 ASTRSK=52 EQSIGN=75 RUBOUT=177 CTRLU=25 CTRLX=30 .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C CNTRLZ=32 ; WAITR=3 XWRITE=4 TELEPR=2 XREAD=5 KEYBRD=3 HIFREE=42 KBLADR=50 KBLRES=52 PS=177776 .ENDC ;<<<<<<<<<<<<<<<<<<<< ; TRAP INSTRUCTION IS USED TO PRINT ERRORS .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C ERROR=104000 TRAPV=30 .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ERROR=104400 TRAPV=34 ; MONITOR I/O MACROS .MCALL .FETCH,.LOOKUP,.ENTER,.CLOSE,.READ .MCALL .WRITE,.EXIT,.RENAME,.TTYIN,.TTYOUT .MCALL .CSISPC,.RELEAS,.SETTOP,.RCTRLO,.PRINT .MCALL .LOCK,.UNLOCK,.WAIT,.QSET,.SRESET .MCALL .DSTATUS .MCALL ..V1.. ..V1.. ; MONITOR COMMUNICATION AREA ERRWD=52 HILOC=50 R6INIT=42 JOBSTAT=44 RMONTP=54 USRADD=46 ; MONITOR PARAMETERS UBOFF=266 ;OFFSET TO BOTTOM OF USR/CSI ULCASE=40000 ;UPPER/LOWER CASE BIT IN JSW (BIT 14) .ENDC ;<<<<<<<<<<<<<<<<<<<< ;ERROR TRAP VECTOR ;ERRORS CAUSE A TRAP TO THE ERROR ROUTINE WITH ERROR NUMBER ;IN RIGHTMOST BYTE OF TRAP INSTRUCTION. ERROR NUMBER IS USED ;AS AN INDEX INTO THE ERROR MESSAGE TABLE .ASECT .=TRAPV ;TRAP VECTOR ERRORT ;ADDRESS OF ERROR REPORTING ROUTINE 0 ;ERROR PRIORITY=0 .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;MONITOR COMMUNICATION AREA .=JOBSTAT 0 ;JOB STATUS WORD .=USRADD 0 ;SWAP ADDRESS FOR FLOATING USR .ENDC ;<<<<<<<<<<<<<<<<<<<< ;ERROR REPORTING ROUTINE. TYPES OUT ERROR MESSAGE,THEN GETS NEW ;COMMAND STRING FROM USER .CSECT .GLOBL START ;MAKE STARTING ADDR SHOW UP IN MAP ERRORT: .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R .UNLOCK ;UNLOCK THE USR IN CASE IT WAS LOCKED IN .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C IOT .BYTE 0,0 ;CONTROL /O RESET .WORD 0 CLR @#PS ;DOWN TO ALLOW ERR.MESS. OUT .ENDC ;<<<<<<<<<<<<<<<<<<<< MOV @SP,R3 ;ERROR TRAP ADDRESS INTO R3 MOV -(R3),R4 ;ERROR TRAP INST INTO R4 BIC #177400,R4 ;STRIP TO ARGUMENT BYTE ASL R4 ;TIMES 2=ADDR OF MESSAGE JSR PC,CRLF ;ISSUE CR,LF TO TTY MOVB #QMARK,R0 ;TYPE "?" ON TTY JSR PC,TYPCHAR JSR PC,ASTYP ;TYP "*" IF EXECUTUION TIME ERROR MOV ERRTAB(R4),R3 ;R3 POINTS TO ASCIZ ERROR MESSAGE JSR PC,EPRINT ;TYPE IT TSTB MACFLG ;YES-ARE WE DOING A MACRO? BEQ E64$ ;NO-FINISH ERROR MESSAGE MOV #MACMSG,R3 ;YES-TELL THE USER SO JSR PC,EPRINT ;PRINT "IN MACRO" ERROR MESSAGE E64$: JSR PC,ASTYP ;TYP "*" IF EXECUTION TIME ERROR MOVB #QMARK,R0 ;FOLLOW THE MESSAGE WITH "?" JSR PC,TYPCHAR JSR PC,CRLF ;AND A CRLF POSTERR:CLRB MACFLG ;CLEAR MACRO FLAG (IN CASE ERROR ;OCCURRED WHILE WE WERE EXECUTING A MACRO MOV EDSTRT,SP ;RE-INITIALIZE THE STACK .IFNDF NODISP ;>G>G>G>G>G>G>G TSTB DSFLG ;ARE WE USING DISPLAY? BEQ 1$ ;NO DONT REFRESH DISPLAY CLRB SCFLG ;CLEAR IMMEDIATE MODE FLAG JSR PC,DUPDAT ;THEN UPDATE DISPLAY 1$: .ENDC ;<<<<<<<<<<<<<< JMP ASTER ;GET NEW COMMAND STRING ;EDITOR FLAGS ;FLAGS USED BY COMMAND STRING INTERPRETER LOOP ;ORDER CANNOT CHANGE WITHOUT CHANGING FLAG CLEARING ;INSTRUCTIONS IN THE COMMAND LOOP NEGFLG: .BYTE 0 ;ARG IS NEGATIVE SLSFLG: .BYTE 0 ;"/" HAS BEEN SEEN SPCFLG: .BYTE 0 ;ANY SPECIAL CHARACTER HAS BEEN SEEN NUMFLG: .BYTE 0 ;A DIGIT HAS BEEN SEEN EQSFLG: .BYTE 0 ;"=" HAS BEEN SEEN MACFLG: .BYTE 0 ;WE ARE CURRENTLY EXECUTING A MACRO ALTFLG: .BYTE 0 ;ALTMODE SEEN ON INPUT SRCFLG: .BYTE 0 ;SEARCH IN PROGRESS EOFFLG: .BYTE 0 ;EOF HAS BEEN SEEN IN INPUT FILE INOFLG: .BYTE 0 ;AN INPUT FILE IS OPEN OTOFLG: .BYTE 0 ;AN OUTPUT FILE IS OPEN .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R EBFLG: .BYTE 0 ;EDIT BACKUP IN PROGRESS .ENDC ;<<<<<<<<<<<<<<<<<<<< EFFLG: .BYTE 0 ;LAST BLOCK OF FILE HAS BEEN READ SRFLG: .BYTE 0 ;FLAG USED BY READ TO SIGNIFY AT LEAST ONE NON-NULL CHAR HAS BEEN READ EXFLG: .BYTE 0 ;EXIT IN PROGRESS EPFLG: .BYTE 0 ;SET TO 1 WHEN COMMAND PROCESSOR IS IN ERROR PASS MINFLG: .BYTE 0 ;SET TO 1 WHEN PROCESSING A MACRO DURING ERROR PASS DELIM: .BYTE 0 ;HOLDS CURRENT MACRO DELIMETER FOR ERROR PASS .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G SCFLG: .BYTE 0 ;SET TO 1 FOR IMMEDIATE MODE DSFLG: .BYTE 0 ;SET TO 1 IF DISPLAY IS ACTIVE FTFLG: .BYTE 0 ;SET TO 1 WHEN 1ST COMMAND SEEN .ENDC ;<<<<<<<<<<<<<<<<<<<< .EVEN ;EDITOR COUNTERS AND MISCELLANEOUS REGISTERS HAND1N: .WORD 0 ;NAME OF DEVICE IN HANDLER AREA 1 HAND2N: .WORD 0 ;NAME OF DEVICE IN HANDLER AREA 2 MACCNT: .WORD 0 ;NUMBER OF TIMES TO EXECUTE CURRENT MACRO PTR: .WORD 0 ;CURRENT CHARACTER POINTER ARG: .WORD 0 ;CURRENT COMMAND ARGUMENT MACR1: .WORD 0 ;SAVED CS POINTER WHILE MACRO BEING EXECUTED OBLENG: .WORD 0 ;LENGTH OF TEXT OBJECT ***MUST BE FOLLOWED BY OBSTRT*** OBSTRT: .WORD 0 ;START OF TEXT OBJECT RELATIVE TO START OF CIB TMP: .WORD 0 ;TEMPORARY CBASE: .WORD 0 ;BASE ADDRESS OF CURRENT COMMAND STRING CREL: .WORD 0 ;RELATIVE COMMAND POINTER WITHIN COMMAND LINE EQLENG: .WORD 0 ;LENGTH OF LAST TEXT OBJECT FOR "=" ;PAGE BUFFER POINTERS ;DIVIDES TEXT AREA INTO FOUR BUFFERS BEND: 0 ;END OF MACRO BUFFER MBSTRT: 0 ;START OF MACRO BUFFER SBSTRT: 0 ;START OF SAVE BUFFER CBEND: 0 ;END OF COMMAND BUFFER CBSTRT: 0 ;START OF COMMAND BUFFER PBSTRT: 0 ;START OF PAGE BUFFER ;LOAD MODULE UPPER AND LOWER BOUNDS ;USED TO ESTABLISH STACK AND DYNAMIC AREA START EDSTRT: .LIMIT ;STACK START ADDR EDTOP=EDSTRT+2 ;DYNAMIC START ADDR ;ITERATION LOOP STACK AREA ISTCKE: .=.+120 ;ITERATION STACK-20 2 WORD ENTRIES LONG ISTCKA: ;START OF STACK ;I/O POINTERS OBPTR: 0 ;POINTER INTO OUTPUT BUFFER OBLKNM: 0 ;CURRENT BLOCK IN OUTPUT FILE IBPTR: 0 ;POINTER INTO INPUT BUFFER IBLKNM: 0 ;CURRENT BLOCK IN INPUT FILE .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;I/O QUEUE AREA IOQ: 0 .=.+42. ;RESERVE SPACE FOR 3 ENTRIES ;DSTATUS BLOCK FOR RELEAS SUBROUTINE CORADD: .WORD 0,0,0,0 ;ARGUMENT BLOCK FOR .DSTATUS ;CSI DEFAULT EXTENSION LIST DEFEXT: .WORD 0,0 ;NO DEFAULT EXTENSIONS, REALLY ; CSI WORKING AREA CSIBLK: .BLKW 39. ;CSI WORK AREA CSISTR: .BLKW 11. ;CSI INPUT STRING (19. CHARS ;+ '<' PLUS NULL TERMINATOR). ;I/O FILE NAMES FILENG: .WORD 0 ;LENGTH OF LAST FILE SPECIFIED ;IN FNGET INBLK: .WORD 75250 ;RAD50 DEV NAME FOR INPUT FILE (SY FOR DEFAULT DEV) .WORD 0 .WORD 0 ;RAD50 FILE NAME FOR CURRENT INPUT FILE .WORD 0 OUTBLK: .WORD 75250 ;RAD50 DEV NAME FOR OUTPUT FILE (SY FOR DEFAULT) .WORD 0 .WORD 0 ;RAD50 FILE NAME FOR CURRENT OUTPUT FILE .WORD 0 .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C DEVPTR: .WORD 0 ;HOLDS I.O CHAN. BYTE ;I/O BUFFERS IBUFF1: 0 ;IN. BUFF. #1 .=.+126. IBUFF2: 0 ;IN. BUFF. #2 .=.+126. IBEND: OBUFF1: 0 ;OUT. BUFF. #1 .=.+126. OBUFF2: 0 ;OUT. BUFF #2 .=.+126. OBEND: ;I/O FILE NAMES INBLK: .WORD 0,0,0,0,0 ;INPUT FILE NAME OUTBLK: .WORD 0,0,0,0 ;NAME .BYTE 0 .BYTE 1 ;ASCII TYPE .BYTE 0,200 ;LENGTH .BYTE 0,0 ;SEQ/CONT OBDATE: .WORD 0,0,0 ;DATE .WORD 0,0,0,0,0,0 ;EXTRA .ENDC ;<<<<<<<<<<<<<<<<<<<< ;I/O BUFFERS IBUFF1: 0 ;INPUT BUFFER 1 .=.+776 IBUFF2: 0 ;INPUT BUFFER 2 .=.+776 IBEND=. ;MARK END OF INPUT BUFFER 2 ; USR WILL SWAP OVER THE NEXT 10000 BYTES: USRSWP: OBUFF1: 0 ;OUTPUT BUFFER 1 .=.+776 OBUFF2: 0 ;OUTPUT BUFFER 2 .=.+776 OBEND=. ;MARK END OF OUTPUT BUFFER 2 ;SUBROUTINE CRLF-PUTS CR AND LF ON CONSOLE TTY CRLF: CMPB LASTC,#12 BEQ CRLFOUT MOVB #CR,R0 ;TYPE A JSR PC,TYPCHAR LFOUT: MOVB #LF,R0 JSR PC,TYPCHAR CRLFOUT:RTS PC ;SUBROUTINE ASTYP ;TYPES AN "*" IF EPFLG=0 ASTYP: TSTB EPFLG ;ARE WE ON ERROR PASS? BNE ASTYPR ;YES-RETURN MOVB #ASTRSK,R0 ;NO-TYPE AN "*" JSR PC,TYPCHAR ASTYPR: RTS PC ;SUBROUTINE EPRINT ;PRINTS ASCII MESSAGE POINTED TO BY R3 ON TELETYPE ;DESTROYS R0 EPRINT: MOVB (R3)+,R0 ;PRINT MSG CHAR JSR PC,TYPCHAR TSTB (R3) ;DONE? BNE EPRINT ;NO-DO NEXT CHARACTER RTS PC ;YES-RETURN .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C ; ; SUBROUTINE TTYOUT - OUTPUT SINGLE CHAR. (UNFORM. ASCII) ; TTYOUT: IOT ;WAIT FOR TTY .BYTE WAITR,TELEPR + TTYOUT ;BUSY RETURN MOVB R0,EDBUFF ;PLACE CHAR. IOT ;WRITE .BYTE XWRITE .BYTE TELEPR + TTOUTB RTS PC ; TTOUTB=.-2 ;BUFF. SIZE (IGN. ON WRITE) .BYTE 0 ;MODE: FORM. ASCII .BYTE 200 ;ST/ERR .WORD 1 ;ONE BYTE BUFFER EDBUFF: .BYTE 0 .EVEN .ENDC ;<<<<<<<<<<<<<<<<<<<< ;SUBROUTINE TYPCHAR ;OUTPUTS A CHARACTER TO THE TTY ;ALL TTY OUTPUT MUST GO THROUGH THIS ROUTINE BECAUSE IT HANDLES TABS, ;FORM FEEDS,ALTMODES ETC. TYPCHAR:MOVB R0,(PC)+ ;SAVE THIS CHAR AS LAST CHAR TYP .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R LASTC: 12 ;INIT. TO LF .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C LASTC: 0 ;ST. W/ CR,LF .ENDC ;<<<<<<<<<<<<<<<<<<<< CMPB R0,#12 ;IS CHAR A LF? BNE E121$ ;NO .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C E122$: JSR PC,TTYOUT .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R E122$: .TTYOUT .ENDC ;<<<<<<<<<<<<<<<<<<<< RTS PC ;RETURN E121$: MOV R0,-(SP) ;SAVE CHAR CMPB R0,#40 ;IS CHAR PRINTABLE? BGE E120$ ;YES - GO PRINT IT CMPB R0,#FF ;IS IT A FORM FEED? BNE E123$ ;NO MOV #LF,R0 ;YES-ECHO LINE FEEDS MOV #10,E124$ ;8 OF 'EM E125$: JSR PC,E122$ DEC (PC)+ ;DONE? E124$: 0 ;COUNTER FOR FORM FEED ECHO BGT E125$ ;NO-DO ANOTHER EE118$: MOV (SP)+,R0 ;YES-RESTORE R0 RTS PC ;RETURN E123$: CMPB R0,#15 ;IS CHAR A CR? BNE E126$ ;NO MOV #11,E127$ ;YES-RESET TAB COUNTER BR E120$ ;PRINT IT E126$: CMPB R0,#11 ;IS CHAR A TAB? BEQ E8$ ;YES CMPB R0,#33 ;NO-IS IT AN ALTMODE? BNE E119$ ;NO MOVB #'$,R0 ;YES-TYP "$" E119$: CMPB R0,#40 ;IS CHAR NON-PRINTING? BGE E120$ ;NO-PRINT IT MOVB #'^,R0 ;YES-ECHO "^X" .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C E128$: JSR PC,TTYOUT .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R E128$: .TTYOUT .ENDC ;<<<<<<<<<<<<<<<<<<<< MOV (SP),R0 ;RESTORE CHAR TO R0 BIS #100,R0 ;WHERE X IS CHAR - 100 .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C E120$: JSR PC,TTYOUT .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R E120$: .TTYOUT .ENDC ;<<<<<<<<<<<<<<<<<<<< DEC E127$ ;DECREMENT TAB COUNTER BNE EE118$ ;RETURN IF TAB COUNTER NOT EMPTY EE117$: MOV #10,(PC)+ ;RESET TAB COUNTER E127$: 0 ;TAB COUNTER BR EE118$ ;RETURN E8$: MOV #40,R0 ;FOR TABS,ECHO SPACES JSR PC,E122$ ;TYPE IT DEC E127$ ;AS MANY AS ARE NEEDED TO REACH BGT E8$ ;MORE BR EE117$ ;DONE ;ERROR MESSAGE TABLE ;CONTAINS STARTING ADDRESSES OF ERROR MESSAGES ERRTAB: MSG0 ;"<>" ERR MSG1 ;ILL ARG MSG2 ;ILL CMD MSG3 ;CB FULL MSG4 ;NO ROOM MSG5 ;SRCH FAIL MSG6 ;ILL MAC MSG7 ;EOF MSG10 ;HDW ERR MSG11 ;FILE FULL MSG12 ;ILL DEV MSG13 ;FILE NOT FND MSG14 ;NO FILE MSG15 ;DIR FULL MSG16 ;ILL NAME .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C MSG17 ;I.O CHAN. CONFLICT MSG20 ;TAPE FULL .ENDC ;<<<<<<<<<<<<<<<<<<<< ;ERROR MESSAGES ;ASCII ERROR MESSAGES ARE STORED HERE ;ALL MESSAGES MUST END IN A 0 BYTE MSG0: .ASCII /"<>" ERR/ .BYTE 0 MSG1: .ASCII /ILL ARG/ .BYTE 0 MSG2: .ASCII /ILL CMD/ .BYTE 0 MSG3: .ASCII /CB FULL/ .BYTE 0 MSG4: .ASCII /NO ROOM/ .BYTE 0 MSG5: .ASCII /SRCH FAIL/ .BYTE 0 MSG6: .ASCII /ILL MAC/ .BYTE 0 MSG7: .ASCII /EOF/ .BYTE 0 MSG10: .ASCII /HDW ERR/ .BYTE 0 MSG11: .ASCII /FILE FULL/ .BYTE 0 MSG12: .ASCII /ILL DEV/ .BYTE 0 MSG13: .ASCII /FILE NOT FND/ .BYTE 0 MSG14: .ASCII /NO FILE/ .BYTE 0 MSG15: .ASCII /DIR FULL/ .BYTE 0 MSG16: .ASCII /ILL NAME/ .BYTE 0 .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C MSG17: .ASCII -I/O CHAN CONFLICT- .BYTE 0 MSG20: .ASCII /TAPE FULL/ .BYTE 0 .ENDC ;<<<<<<<<<<<<<<<<<<<< MACMSG: .ASCII / IN MACRO/ .BYTE 0 .EVEN ;EDITOR COMMAND TABLES ;COMMAND NAME TABLES-HOLDS SINGLE CHARACTERS FOR EDIT COMMANDS CTABLE: ;COMMANDS BELOW THIS POINT ALLOW NO ARGUMENTS NOARG: .BYTE 'R ;READ .BYTE 'B ;BEGINNING .BYTE 'V ;VERIFY .BYTE 'I ;INSERT .BYTE '> ;ITERATION END ;COMMANDS BELOW THIS POINT ALLOW "0" ARGUMENT ONLY ZROARG: .BYTE 'U ;UNSAVE .BYTE 'M ;MACRO ;COMMANDS BELOW THIS POINT ALLOW POSITIVE ARGUMENTS ONLY POSARG: .BYTE 'N ;NEXT .BYTE 'S ;SAVE .BYTE 'G ;GET .BYTE 'F ;FIND .BYTE 'P ;POSITION .BYTE '< ;ITERATION START ;COMMANDS BELOW THIS POINT ALLOW ALL ARGUMENTS EXCEPT "@" EXCPAT: .BYTE 'W ;WRITE .BYTE 'A ;ADVANCE .BYTE 'X ;EXCHANGE .BYTE 'L ;LIST .BYTE 'K ;KILL ;COMMANDS BELOW THIS POINT ALLOW ALL ARGUMENTS ALLARG: .BYTE 'D ;DELETE .BYTE 'C ;CHANGE CTEND: .BYTE 'J ;JUMP ;COMMANDS BELOW THIS POINT ARE TWO LETTER COMMANDS,THE FIRST OF WHICH IS "E" ETABLE: .BYTE 'M ;EXECUTE MACRO .BYTE 'X ;EXIT .BYTE 'R ;EDIT READ .BYTE 'W ;EDIT WRITE .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R .BYTE 'B ;EDIT BACKUP .BYTE 'L ;EDIT LOWER .BYTE 'U ;EDIT UPPER .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G .BYTE 'D ;EDIT DISPLAY .BYTE 'C ;EDIT CONSOLE .ENDC ;<<<<<<<<<<<<<<<<<<<< .BYTE 'V ;EDIT VERSION ETEND: .BYTE 'F ;END FILE .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G ;COMMANDS BELOW ARE EXECUTED IN EXTENDED DISPLAY MODE STABLE: ;COMMANDS BELOW HAVE 0 OR NO ARGUMENT NARG: .BYTE ALTMDE,175,176 ;ALTMODES ;COMMANDS BELOW HAVE POSITIVE ARG PARG: .BYTE 'N-100 ;CURSOR TO NEXT LINE (ADVANCE) .BYTE 'D-100 ;CURSOR FORWARD ONE CHAR ;COMMANDS BELOW HAVE NEGATIVE ARG MARG: .BYTE 'V-100 ;CURSOR BACK ONE CHAR .BYTE 'G-100 ;CURSOR UP ONE LINE STEND: .BYTE RUBOUT ;DELETE CHAR PRECEDING CURSOR .ENDC ;<<<<<<<<<<<<<<<<<<<< .EVEN ;ERROR PASS DISPATCH TABLES ;THESE TABLES ARE USED TO DISPATCH TO ROUTINES ON ERROR PASS EPTAB1: JR ;READ JR ;BEGIN JR ;VERIFY TMODE ;INSERT RGTBRK ;> JR ;UNSAVE MACEP ;MACRO JR ;NEXT JR ;SAVE TMODE ;GET TMODE ;FIND TMODE ;POSITION LFTBRK ;< JR ;WRITE JR ;ADVANCE TMODE ;XCHANGE JR ;LIST JR ;KILL JR ;DELETE TMODE ;CHANGE JR ;JUMP ;JR IS SIMPLY AN RTS PC EPTAB2: EMACEP ;EXECUTE MACRO JR ;EXIT TMODE ;EDIT READ TMODE ;EDIT WRITE .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R TMODE ;EDIT BACKUP JR ;EDIT LOWER JR ;EDIT UPPER .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G JR ;EDIT DISPLAY JR ;EDIT CONSOLE .ENDC ;<<<<<<<<<<<<<<<<<<<< JR ;EDIT VERSION JR ;END FILE ;EDITOR DISPATCH TABLE ;ON THE EXECUTION PASS,THIS TABLE IS USED AS THE JUMP TABLE FOR ;THE VARIOUS COMMAND ROUTINES DTABLE: READ BEGIN VERIFY INSERT RGTBRK UNSAVE MACRO NEXT SAVE GET FIND POSITN LFTBRK WRITE ADVNCE XCHNGE LIST KILL DELETE CHANGE JUMP EDTABL: EMACRO EXIT EREAD EWRITE .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R EBCKUP ELOWER EUPPER .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G EDSPLY ECONS .ENDC ;<<<<<<<<<<<<<<<<<<<< EVERS EFILE .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G ;DISPLAY MODE DISPATCH TABLE SDTABL: ALTM ALTM ALTM ADVNCE JUMP JUMP ADVNCE DELETE .ENDC ;<<<<<<<<<<<<<<<<<<<< ;ROUTINE COMAND ;BASIC EDITOR COMMAND LOOP ;EXPECTS CBASE TO POINT TO A COMMAND STRING WHICH ENDS IN A 0 BYTE. ;MAKES TWO PASSES OVER THE COMMAND STRING. THE FIRST USES THE ;DISPATCH TABLES AT EPTAB1 AND EPTAB2,CALLING THE APPROPRIATE ERROR ;CHECKING ROUTINE FOR EACH COMMAND. THE SECOND TIME THROUGH,THE ;DISPATCH TABLES AT DTABLE ARE USED,CALLING THE ACTUAL COMMAND EXECUTIONE ;ROUTINES. COMAND: INCB EPFLG ;COMMENCE ERROR PASS COMND1: CLR CREL ;START POINTER AT BEGINNING OF COMMAND CLRB MINFLG ;MACRO PROCESS FLAG CLEARED CLOOP: MOV CBASE,R1 ;START OF COMMAND STRING ADD CREL,R1 ;R1 IS ABSOLUTE POINTER INTO CS CLR SPCFLG ;CLEAR SPECIAL CHARACTER AND NUMBER SEEN FLAG CLR NEGFLG ;CLEAR NEGATIVE AND "/" FLAG CLRB EQSFLG ;CLEAR = SEEN FLAG CLRB SRCFLG ;CLEAR SEARCH IN PROGRESS FLAG CLR R2 ;ZERO ARGUMENT C16$: TSTB MINFLG ;ARE WE PROCESSING A MACRO? BEQ CL3 ;NO CMPB (R1),DELIM ;DELIMETER SEEN? BEQ MOUTEP ;YES TSTB (R1) ;NO-END OF STRING? BNE C11$ ;NO ERROR+6 ;YES-DELIMETER ERROR MOUTEP: CMP ISTACK,TMP ;DID MACRO MAKE A NET CHANGE IN BEQ MOUTP1 ;THE ITERATION STACK? ERROR+0 ;YES-"<> ERR" MOUTP1: CLRB MINFLG ;DELIMETER SEEN-CLEAR MACRO PROCESS FLAG JMP CECOM ;NEXT CHAR CL3: TSTB (R1) ;END OF STRING? BNE C11$ ;NO TSTB MACFLG ;ARE WE PROCESSING A MACRO? BNE CL1 ;YES-NO NEED TO CHECK STACK CMP ISTACK,#ISTCKA ;IS STACK FREE BEQ CL1 ;YES ERROR+0 ;NO-"<>" ERROR CL1: TSTB EPFLG ;ERROR PASS BNE CL2 ;YES .IFNDF NODISP ;>G>G>G>G>G>G>G TSTB DSFLG ;IS DISPLAY BEING USED? BEQ 1$ ;NO - DON'T GO UPDATE IT JSR PC,DUPDAT ;UPDATE THE DISPLAY 1$: .ENDC ;<<<<<<<<<<<<<< JMP ASTER ;NO-GET NEXT COMMAND STRING CL2: CLRB EPFLG ;START EXECUTION PASS BR COMND1 C11$: CMPB (R1),#SPACE ;IS NEXT CHAR A SPACE? BEQ E12$ ;YES-IGNORE IT CMPB (R1),#ALTMDE ;IGNORE ALTMODES BETWEEN COMMANDS BEQ E12$ CMPB (R1),#CR ;NO-IS IT A CR? BEQ E12$ ;YES-IGNORE IT CMPB (R1),#LF ;NO-IS IT A LF? BEQ E12$ ;YES-IGNORE IT CMPB (R1),#PLUS ;NO-IS IT A "+" BNE E13$ ;NO-CHECK FOR A "=" JSR PC,CHECKF ;YES-MAKE CERTAIN IT IS LEGAL BR E12$ ;THEN MOVE ON E13$: CMPB (R1),#MINUS ;IS IT A "=" BNE E14$ ;NO-CHECK FOR A "/" JSR PC,CHECKF ;MAKE SURE ITS LEGAL INCB NEGFLG ;YES SET NEGATIVE FLAG BR E12$ ;CONTINUE E14$: CMPB (R1),#SLASH ;IS IT A "/" BNE E17$ ;NO-CHECK FOR A "=" JSR PC,CHECKF ;MAKE SURE ITS LEGAL INCB SLSFLG ;YES-SET "/" FLAG BR E12$ ;MOVE ON E17$: CMPB (R1),#EQSIGN ;IS IT AN "=" BNE E15$ ;NO-CHECK FOR A DIGIT JSR PC,CHECKF ;YES-MAKE SURE IT'S LEGAL INCB EQSFLG ;MARK IT SEEN INCB NEGFLG ;= IS A NEGATIVE ARGUMENT BR E12$ ;MOVE ON E15$: CMPB (R1),#ZERO ;IS CHAR <0? BLO CNTDIG ;YES-IT IS NOT A DIGIT CMPB (R1),#NINE ;IS CHAR <9? BHI CNTDIG ;NO-IT IS NOT A DIGIT TSTB SLSFLG ;YES-CHAR IS DIGIT. "/" SEEN? BNE ERR1 ;YES-ARGUMENT ERRROR TSTB EQSFLG ;CHAR IS DIGIT ;= SEEN? BNE ERR1 ;YES-ILLEGAL ARG MOVB (R1),R4 ;MOVE DIGIT INTO R4 AS A TEMPORARY BIC #177760,R4 ;STRIP TO 4 BITS ASL R2 MOV R2,-(SP) ASL R2 ;MULTIPLY CURRENT ARG BY 10 ASL R2 ADD (SP)+,R2 ADD R4,R2 ;AND ADD IN MOST RECENT DIGIT BCS ERR1 ;ARGUMENT TOO LARGE BIT #140000,R2 ;TEST FOR AN ARG>16384 BNE ERR1 ;IF SO,IT IS TOO BIG ADD #401,SPCFLG ;SET SPECIAL CHARACTER AND NUMBER SEEN FLAGS E12$: INC R1 ;BUMP POINTER TO NEXT CS CHARACTER INC CREL ;UPDATE CS POINTER BR C16$ ;CONTINUE ERR1: ERROR+1 ;ILLEGAL ARGUMENT ;IF WE GET THIS FAR,CHAR MUST BE A COMMAND OR IT IS ILLEGAL CNTDIG: JSR PC,UCTRAN ;TRANSLATE COMMAND CHAR TO UPPER CASE CMPB (R1),#E ;IS CHARACTER "E"? BEQ ECMD ;YES-IT IS A TWO LETTER COMMAND MOV #NOARG,R4 ;NO-SET UP SEARCH E63$: CMPB (R4)+,(R1) ;SEARCH FOR CHAR IN CTABLE BEQ CFOUND ;MATCH CMP R4,#CTEND+1 ;NO-MATCH. CHECK FOR END OF TABLE BLO E63$ ;END NOT REACHED-CONTINUE SEARCH ERR2: ERROR+2 ;END OF TABLE REACHED-ILLEGAL COMMAND ;COMMAND CHAR HAS BEEN FOUND CFOUND: CMP R4,#ALLARG ;IS COMMAND IN ALL ARG SECTION? BHI E24$ ;YES-ALL ARGS ARE LEGAL-DISPATCH TO COMMAND TSTB EQSFLG ;WAS "=" SEEN? BNE ERR1 ;IF SO,IT WAS AN ILLEGAL ARG CMP R4,#EXCPAT ;DOES COMMAND ALLOW ALL ARGS EXCEPT "@"? BHI E26$ ;YES-GO EXECUTE IT CMP R4,#POSARG ;NO-IS COMMAND PAST POS ARG SECTION? BLOS E22$ ;NO-CHECK IF ZERO ARGS ALLOWED TSTB NUMFLG ;NUMBER SEEN YET? BEQ E21$ ;NO-ZERO ARG IS CORRECT TST R2 ;CHECK THE ARGUMENT BEQ ERR1 ;IF =0 IT IS ILLEGAL E21$: TSTB NEGFLG ;MINUS SIGN TYPED? BNE ERR1 ;YES-ARG ILLEGAL TSTB SLSFLG ;SLASH SEEN? BNE ERR1 ;YES-ILLEGAL ARG BR E26$ ;ARG IS LEGAL-CALL SUBROUTINE E22$: CMP R4,#ZROARG ;DOES COMMAND ALLOW "0" ARGUMENT? BLOS E23$ ;NO-IT ALLOWS NO ARGS TST R2 ;YES-IS ARG=0? BEQ E26$ ;YES-EXECUTE COMMAND E23$: TSTB SPCFLG ;ANY ARG TYPED? BNE ERR1 ;YES-ILLEGAL ARGUMENT ;EXECUTE COMMAND E24$: TSTB EQSFLG ;WAS ARG "="? BEQ E26$ ;NO MOV EQLENG,R2 ;YES-ARG WAS LENGTH OF LAST TEXT OBJ BR E25$ E26$: TSTB NUMFLG ;NUMBER SEEN? BNE E25$ ;YES INC R2 ;NO-SET ARG=1 E25$: SUB #CTABLE+1,R4 ;FIND COMMAND NUMBER MOV #EPTAB1,R3 ;R3 POINTS TO ERROR PASS DISPATCH TABLE TSTB EPFLG ;ARE WE IN ERROR PASS? BNE CMDEX ;YES-USE ERROR TABLE ADD #DTABLE-EPTAB1,R3 ;NO-USE REGULAR DISPATCH TABLE BR CMDEX ;EXECUTE THE COMMAND ;SEARCH FOR "E" COMMANDS ECMD: INC CREL INC R1 ;POINT TO CHAR FOLLOWING "E" JSR PC,UCTRAN ;TRANSLATE CHARACTER TO UPPER CASE MOV #ETABLE,R4 ;SET UP SEARCH E31$: CMPB (R4)+,(R1) ;SEARCH FOR COMMAND IN ETABLE BEQ E32$ ;FOUND IT? CMP R4,#ETEND+1 ;NO-END OF TABLE YET? BHIS ERR2 ;YES-ILLEGAL COMMAND BR E31$ ;NO-CONTINUE ;"E" COMMAND FOUND E32$: CMPB (R1),#M ;IS CMD=EM? BEQ C35$ ;YES-POSITIVE ARGS ALLOWED JSR PC,CHECKF ;NO-NO ARGS ALLOWED C33$: SUB #ETABLE+1,R4 ;FINE COMMAND # MOV #EPTAB2,R3 ;POINT R3 TO ERROR PASS DISPATCH TABLE TSTB EPFLG ;ARE WE IN ERROR PASS? BNE CMDEX ;YES-USE ERROR TABLE ADD #EDTABL-EPTAB2,R3 ;NO-USE REGULAR TABLE ;COMMAND EXECUTER ;CALLED WITH ARG IN R2,COMMAND # IN R4,AND POINTER TO ;DISPATCH TABLE IN R3 CMDEX: MOV R2,ARG ;SET UP ARG ASL R4 ;CMD #*2=INDEX OF ADDR IN JUMP TABLE MOV R3,TABIND ;PUT TABLE POINTER AS INDEX OF NEXT INST .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G TSTB EPFLG ;ERROR PASS? BNE 1$ ;YES - DON'T CHECK FOR 'ED' CMD JSR PC,CHECKC ;SEE IF WE CAN RECLAIM DISPLAY CORE 1$: .ENDC ;<<<<<<<<<<<<<<<<<<<< JSR PC,@0(R4) ;JUMP TO COMMAND SUBROUTINE TABIND=.-2 CECOM: INC CREL ;MOVE POINTER TO NEXT CHAR JMP CLOOP ;NEXT COMMAND C35$: TSTB NEGFLG ;NEGATIVE ARGUMENT? BNE ERR1 ;YES-ILLEGAL TSTB SLSFLG ;SLASH SEEN? BNE ERR1 ;YES-ILLEGAL ARG TSTB NUMFLG ;WAS A NUMBER TYPED? BNE E34$ ;YES-CHECK IT INC R2 ;NO NUM TYPED-SET ARG TO 1 E34$: TST R2 ;YES-IT BETTER NOT BE 0 BEQ ERR1 ;IT IS-ERROR BR C33$ ;ARG OK-CONTINUE ;SUBROUTINE CHECKF ;USED BY THE COMMAND LOOP TO CHECK VARIOUS ARGUMENT FLAGS WHEN A ;CHARACTER SUCH AS +,- AND / ARE SEEN CHECKF: TST SPCFLG ;NUMBER OR SPECIAL CHAR SEEN YET? BNE ERR1 ;YES-ILLEGAL ARG TSTB NEGFLG ;MINUS SIGN SEEN YET? BNE ERR1 ;YES-ILLEGAL ARG INCB SPCFLG ;NO-SET IT JR: RTS PC ;RETURN ;SUBROUTINE UCTRAN ;USED BY COMMAND PROCESSING ROUTINES TO TRANSLATE THE CHARACTER ;POINTED TO BY R1 TO UPPER CASE. THE TRANSLATED CHARACTER IS NOT MOVED. UCTRAN: CMPB (R1),#141 ;IS ASCII VALUE OF CHAR<141? BLT E60$ ;YES-OK TO PROCESS CMPB (R1),#172 ;IS CHAR A LOWER CASE ALPHABETIC? BGT E60$ ;NO-OK TO PROCESS BICB #40,(R1) ;YES-TRANSLATE TO UPPER CASE E60$: RTS PC ;RETURN .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G ;THIS ROUTINE ATTEMPTS TO RECLAIM DISPLAY CODE AND BUFFERS ;IF THE SCROLLER IS NOT ACTIVE AND 'EDIT DISPLAY' WAS NOT THE ;FIRST COMMAND ENTERED CHECKC: TSTB FTFLG ;FIRST COMMAND? BEQ 2$ ;NO RETURN CLRB FTFLG ;NEVER RETURN TSTB DSFLG ;IS SCROLLER ACTIVE BNE 2$ ;YES - LEAVE CMP R3,#EDTABL ;WAS IT AN 'E' COMMAND BNE 1$ ;NO - RECLAIM CMPB (R1),#'D ;WAS IT 'ED' BEQ 2$ ;YES - RETURN 1$: MOV ICERR,EDSPLY ;ERROR IF ED IS USED CMP #EDEND,EDTOP ;CAN WE STEAL THE CORE BNE 2$ ;NO - RETURN MOV R4,R0 ;SAVE R4 MOV CBSTRT,R2 ;SET UP PARMS FOR MOV CBEND,R3 ;CIB TO LOWER CORE MOV #DSFILE,R4 ;PLACE TO MOVE IT TO MOV R4,PTR ;RESET POINTERS MOV R4,CBSTRT ; MOV R4,PBSTRT ; MOV R4,CBASE ; MOV R4,EDTOP ;NEW TOP SUB R2,CBEND ;SET UP NEW CBEND ADD R4,CBEND ; JSR PC,MOVDWN ;MOVE IT MOV R0,R4 ;RESTORE R4 MOV ARG,R2 ; R2 MOV TABIND,R3 ; R3 2$: RTS PC ;OUT ICERR: ERROR+2 ;ED ERROR ZAP ;EDITOR IMMEDIATE MODE COMMAND LOOP ;ENTERED UPON RECEIVING DOUBLE ALTMODE IN COMMAND MODE ;EXITS TO COMMAND MODE PROCESSING UPON RECEIPT OF SINGLE ALTMODE ;USES SDTABL TO CALL IMMEDIATE COMMAND ROUTINES ;ALL NON-COMMAND CHARS ARE INSERTED INTO TEXT AUTOMATICALLY REFRSH: JSR PC,DUPDAT ;UPDATE THE DISPLAY SCOMND: .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C IOT .BYTE XREAD,KEYBRD ;READ FROM TTY + TTINBUF INW1: BITB #200,TTST ;WAIT FOR CHAR. BEQ INW1 MOVB CHART,R0 ;COLLECT CHAR. .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R .TTYIN ;GET CHAR FROM TTY .ENDC ;<<<<<<<<<<<<<<<<<<<< CMPB #175,R0 ;CHECK IF CHAR IS IN TABLE BHIS SC1$ ;YES - MATCH IT CMPB #40,R0 ;IS CHAR A CTRL? BHIS SC3$ ;NOT IN TABLE - GO INSERT IT SC1$: MOV #STABLE,R4 ;SET UP TABLE SEARCH TOP MOV #STEND+1,R3 ;TABLE END SC2$: CMPB (R4)+,R0 ;SEARCH CHAR IN STABLE BEQ SFOUND ;MATCH - GO EXECUTE CMD CMP R4,R3 ;END OF TABLE? BLO SC2$ ;NO - CONTINUE SEARCH ;INSERT ANY CHARACTER NOT IN TABLE SC3$: MOV CBEND,R3 ;INITIALIZE 'FROM' PTR FOR MOVUP MOV SBSTRT,R2 ;CHECK IF SPACE IS AVAILABLE SUB R3,R2 ;TEXT BUFF SUB #10,R2 ;ROOM FOR EMERGENCY COMMAND BHIS SC4$ ;SPACE AVAILABLE - CONTINUE ERROR+4 ;"NO ROOM" SC4$: MOV PTR,R2 ;SET CURRENT PTR FOR MOVUP INC CBEND ;BUFFER WILL BE 1 CHAR LARGER INC CBSTRT ;ALSO BUMP CIB START PTR BY 1 MOV CBEND,R4 ;INITIALIZE 'TO' PTR JSR PC,MOVUP ;MAKE ROOM FOR CHAR MOVB R0,(R3)+ ;INSERT CHAR, AND BUMP PTR MOV R3,PTR ;RESET CURSOR POSITION JMP REFRSH ;REFRESH DISPLAY, GET NEXT CHAR ;IMMEDIATE COMD CHAR HAS BEEN FOUND SFOUND: CLRB SLSFLG ;CLEAR "/" SEEN FLAG CLRB NEGFLG ;CLEAR "-" SEEN FLAG CLR R2 ;ZERO ARGUMENT CMP R4,#PARG ;IS ARG +1? BLOS SC5$ ;NO - ZERO INC R2 ;SET ARG TO +1 CMP R4,#MARG ;IS ARG -1? BLOS SC5$ ;NO - +1 INCB NEGFLG ;SET ARG TO -1 SC5$: MOV R2,ARG ;SET UP ARG SUB #STABLE+1,R4 ;CALCULATE CMD NUMBER ASL R4 ;#*2=INDEX INTO JUMP TABLE JSR PC,@SDTABL(R4) ;JUMP TO COMMAND SUBROUTINE JMP REFRSH ;REFRESH DISPLAY, GET NEXT CHAR .ENDC ;<<<<<<<<<<<<<<<<<<<< ;ROUTINE ASTER ;GETS NEXT COMMAND STRING AFTER CURRENT ONE FINISHED ASTER: TSTB MACFLG ;DID WE JUST FINISH A MACRO? BEQ AST1 ;NO-GET NEXT STRING FROM TTY DEC MACCNT ;YES-DECREMENT MACRO COUNT BEQ AST9 ;IF COUNT=0,RESUME MASTER STRING CLR CREL ;COUNT NOT ZERO-START MACRO AGAIN JMP CLOOP ;EXECUTE COMMAND STRING ;MACRO IS FINISHED-RESUME MASTER STRING AST9: MOV CBSTRT,CBASE ;RETURN TO MASTER COMMAND STRING MOV MACR1,CREL ;GET SAVED CS POINTER CLRB MACFLG ;CLEAR MACRO FLAG JMP CECOM ;CONTINUE IN MASTER STRING ;COMMAND STRING MUST COME FROM TTY AST101: JSR PC,CRLF ;ISSUE CRLF AST1: CLRB ALTFLG ;CLEAR ALTMODE FLAG MOV #ISTCKA,ISTACK ;INIT ITERATION STACK MOV SBSTRT,R4 ;START OF SAVE BUFFER INTO R4 SUB CBSTRT,R4 ;TOTAL LENGTH OF CIB=CBSTRT-SBSTRT/2 ASR R4 ;DIVIDE BY 2 .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C AST2: IOT .BYTE 0,0 ;CNTRL O .WORD 0 ;RESET .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R AST2: .RCTRLO ;ENABLE TTY IN CASE HE ^O 'D IT OUT .ENDC ;<<<<<<<<<<<<<<<<<<<< MOV CBSTRT,R3 ;R3 POINTS INTO COMMAND BUFFER MOVB #ASTRSK,R0 ;FOLLOWED BY "*" JSR PC,TYPCHAR AST17: CLR RUBFLG ;CLEAR RUBOUT FLAG .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C AST3: IOT .BYTE XREAD,KEYBRD ;READ FROM TTY + TTINBUF INW2: BITB #200,TTST ;WAIT FOR CHAR. BEQ INW2 MOVB CHART,R0 ;COLLECT CHAR. .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R AST3: .TTYIN ;GET CHAR FROM TTY .ENDC ;<<<<<<<<<<<<<<<<<<<< CMPB R0,#RUBOUT ;IS CHAR RUBOUT BEQ AST12 ;YES-GO TO RUBOUT PROCESSOR TST RUBFLG ;NO-WAS LAST CHAR RUBOUT? BEQ AST16 ;NO MOV R0,-(SP) ;SAVE CHAR MOVB #'\,R0 ;YES-ECHO SECOND "\" JSR PC,TYPCHAR MOV (SP)+,R0 ;RESTORE CHAR CLR RUBFLG ;CLEAR FLAG AST16: CMPB #33,R0 ;IS CHAR AN ALTMODE? BEQ AST5 ;YES-CHECK FOR DOUBLE ALTMODE CMPB #175,R0 ;CHECK FOR OBSOLETE TERMINAL ALTMODES BEQ AST5 CMPB #176,R0 BEQ AST5 CLRB ALTFLG ;NO-CLEAR ALTMODE FLAG JSR PC,TYPCHAR ;ECHO THE CHARACTER .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C CMPB #CR,R0 ;CHAR. = ? BNE CHAREC ;NO JSR PC,LFOUT ;YES: ECHO AFTER IT MOVB #CR,R0 ;RESTORE .ENDC ;<<<<<<<<<<<<<<<<<<<< CHAREC: CMPB R0,#CTRLX ;WAS CHAR. CTRL X? BEQ AST101 ;YES-FORGET EVERYTHING AND START OVER CMPB R0,#CTRLU ;WAS CHAR CTRL U? BNE AST13 ;NO JSR PC,CRLF ;YES-ECHO CRLF CTRULP: CMP R3,CBSTRT ;IS CIB EMPTY? BLOS AST101 ;YES-START OVER MOVB -(R3),R0 ;NO-BACK UP A CHARACTER INC R4 ;AND BUMP SPACE AVAILABLE COUNT CMPB R0,#LF ;WAS CHAR WE BACKED OVER A LF? BNE E61$ ;NO E62$: INC R3 ;YES-RESTORE IT BR AST17 ;AND START LINE FRESH E61$: CMPB R0,#FF ;NO-SAME FOR FORM FEED BEQ E62$ BR CTRULP ;NEITHER-BACK UP AGAIN AST13: MOVB R0,(R3)+ ;PUT CHAR IN CIB DEC R4 ;DECREASE AVAILABLE SPACE COUNT BEQ AST11 ;BUFFER FULL? .IFDF $CAPS11 ;>C>C>C>C>C>C.C.C.C.C CMPB #CR,R0 BNE SZCHK MOVB #LF,R0 ;ON , ALSO INSERT BR AST13 .ENDC ;<<<<<<<<<<<<<<<<<<<< SZCHK: CMP R4,#12 ;NO-ARE WE WITHIN 10 CHARS OF END? BHI AST3 ;NO-GET NEXT MOV R3,-(SP) ;YES-PRINT WARNING MOV #AST8,R3 JSR PC,EPRINT MOV (SP)+,R3 BR JMPAST3 AST11: ERROR+3 ;CIB FULL AST8: .BYTE CR,LF .ASCII /* CB ALMOST FULL */ .BYTE 15,12,0 .EVEN .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C TTINBUF:.WORD 1 ;BUFFSIZE .BYTE 202 ;MODE: UNFORM. ASCII TTST: .BYTE 200 ;STATUS .WORD 1 ;COUNT CHART: .BYTE 0,0 ;CHAR .ENDC ;<<<<<<<<<<<<<<<<<<<< ;ALTMODE SEEN AST5: MOVB #33,R0 ;ECHO $ JSR PC,TYPCHAR TSTB ALTFLG ;WAS LAST CHAR ALTMODE? BNE AST4 ;YES-END OF COMMAND INCB ALTFLG ;NO-SET ALTMODE FLAG MOVB R0,(R3)+ ;PUT ALTMODE IN BUFFER BR AST3 ;NEXT CHAR AST4: CLRB -(R3) ;PUT 0 AT END OF COMMAND INC R3 CLRB (R3) ;WE NEED 2 ZEROES IN CASE LAST CMD IS TEXT CMD MOV R3,CBEND ;MARK END OF COMMAND BUFFER MOV CBSTRT,CBASE ;POINT TO MASTER COMMAND STRING JSR PC,CRLF ;ECHO CRLF FOR DOUBLE ALTMODES .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G TSTB DSFLG ;IS DISPLAY BEING USED? BEQ AST18 ;NO - DON'T CHECK FOR IMMED. MODE TSTB @CBSTRT ;IS CIB EMPTY? BNE AST18 ;NO - PROCESS COMMAND STRING INC SCFLG ;NULL CIB - SET IMMEDIATE MODE MOVB #'!,R0 ;PRINT "!" JSR PC,TYPCHAR ;TO INDICATE MODE JMP SCOMND ;GET NEXT IMMEDIATE CHAR AST18: .ENDC ;<<<<<<<<<<<<<<<<<<<< JMP COMAND ;EXECUTE COMMAND STRING ;RUBOUT PROCESSING AST12: CLRB ALTFLG ;A RUBOUT IS NOT AN ALTMODE CMP R3,CBSTRT ;CIB EMPTY? BNE CHKSLSH ;NO-CHK. SLASH JMP AST101 ;YES-IGNORE CHKSLSH:TST (PC)+ ;NO-"\" PRINTED? RUBFLG: 0 ;RUBOUT FLAG BNE AST15 ;YES-DON'T BOTHER INC RUBFLG ;NO-PRINT IT MOVB #'\,R0 JSR PC,TYPCHAR AST15: MOVB -(R3),R0 ;ECHO RUBBED OUT CHARACTER JSR PC,TYPCHAR INC R4 ;INCREASE AVAILABLE COUNT SPACE JMPAST3:JMP AST3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;; SYSTEM SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;SUBROUTINE TMODE ;REMEMBERS START OF OBJECT IN OBSTRT. SEARCHES FOR ALTMODE. RETURNS ;LENGTH OF TEXT OBJECT IN OBLENG. MOVES R1 TO POINT TO ALTMODE TMODE: INC CREL MOV CREL,R1 ADD CBASE,R1 ;R1 NOW POINTS TO ABS ADDR OF OBJECT MOV CREL,OBSTRT ;REMEMBER THIS START CLR R0 ;ZERO LENGTH E68$: CMPB (R1),#33 ;ALTMODE CHAR? BEQ E69$ ;YES-END OF OBJECT CMPB (R1),#175 ;TEST FOR ALL THREE POSSIBLE ALTMODE CODES BEQ E69$ CMPB (R1),#176 BEQ E69$ TSTB (R1)+ ;0 CAN ALSO END OBJECT IF LAST CMD IN STRING BEQ E69$ INC CREL ;NO-BUMP POINTER INC R0 ;BUMP LENGTH BR E68$ ;LOOP E69$: MOV R0,OBLENG ;TEXT OBJECT LENGTH TSTB EPFLG ;ARE WE IN ERROR PASS? BNE T1 ;YES-ERROR PASS DOES NOT AFFECT = ARG MOV R0,EQLENG ;REMEMBER IT FOR = ARGUMENT T1: RTS PC ;RETURN ;SUBROUTINE CHRARG ;INTERPRETS ARG AS # OF CHARS AND RETURNS WITH R4 POINTING ;TO REFERENCED ADR CHRARG: TSTB SLSFLG ;IS ARG="/"? BNE LCCOM1 ;YES-SET ADR=CBSTST-1 TST ARG ;ARG=0? BEQ LNTSLS ;YES-USE ROUTINE IN LINARG TO FIND ;BEGINNING OF CURRENT LINE CHR1: MOV PTR,R4 ;CURRENT POINTER INTO R4 TSTB NEGFLG ;IS ARG<0? BNE CSUB ;YES-SUBTRACT ARG FROM PTR ADD ARG,R4 ;ADD ARG TO PTR FOR ADR CMP R4,CBSTRT ;IS ADR PAST END? BHIS LCCOM1 ;YES-EQUIV TO "/" RTS PC ;RETURN CSUB: SUB ARG,R4 ;PTR-ARG=ADR CMP R4,PBSTRT ;ADR BEFORE BEG OF BUFFER? BHIS CHRET ;NO-RETURN MOV PBSTRT,R4 ;YES-ADR = BEGINNING CHRET: RTS PC ;SUBROUTINE EMACEP ;ERROR PASS ROUTINE FOR EM COMMAND EMACEP: TSTB MINFLG ;ARE WE PROCESSING A MACRO? BEQ MACEPR ;NO-RETURN ERM: ERROR+6 ;YES-ILLEGAL TO EXECUTE A MACRO FROM WITHIN A MACRO ;SUBROUTINE MACEP ;ERROR PASS ROUTINE FOR M COMMAND MACEP: TST ARG ;0M ? BEQ EMACEP ;YES, JUST CHECK FOR RECURSION INC R1 ;POINT TO DELIMETER INC CREL MOVB (R1)+,DELIM ;STORE DELIMETER BEQ ERM ;END OF STRING MEANS DELIMETER ERROR JSR PC,EMACEP ;TEST FOR RECURSION PROBLEMS MOV ISTACK,TMP ;MARK CURRENT POSITION OF ITERATION STACK INCB MINFLG ;SET FLAG FOR MACRO PROCESSING MACEPR: RTS PC ;SUBROUTINE LINARG ;INTERPRETS ARG AS A LINE ARGUMENT,AND RETURNS WITH R4 POINTING ;TO IMPLIED ADR LINARG: TSTB SLSFLG ;IS ARG="/" BEQ LNTSLS ;NO LCCOM1: MOV CBSTRT,R4 ;ADR IS END OF BUFFER RTS PC ;DONE LNTSLS: MOV PTR,R4 ;CURRENT CHAR POSITION IN R4 TST ARG ;IS ARG=0? BNE LTMIN ;NO-SEE IF <0 MOV #1,R3 ;YES-BACK OVER 1 CRLF BR LBLOOP LTMIN: TSTB NEGFLG ;IS IT <0? BEQ LFOR ;NO-MOVE FORWARD MOV ARG,R3 ;YES-NUMBER OF CRLF'S IN R3 INC R3 ;BACK OVER ARG+1 CRLF LBLOOP: CMP R4,PBSTRT ;IS ADR PAST BEG OF BUFFER? BLOS LRET ;YES-SET ADR AT BEG CMPB -(R4),#LF ;NO-IS PREV CHAR LF? BNE LBLOOP ;NO-BACKUP CMPB -(R4),#CR ;YES-IS PREV CHAR CR? BNE LBLOOP ;NO-BACKUP DEC R3 ;YES-DECREASE COUNT BNE LBLOOP ;MORE CMPB (R4)+,(R4)+ ;DONE-MOVE OVER LAST CRLF ;TO BEG OF NEXT LINE LRET: RTS PC LFOR: MOV ARG,R3 ;NUMBER OF CRLF'S TO STEP OVER IN R3 LFLOOP: CMP R4,CBSTRT ;ADR PAST END? BHIS LCCOM1 ;YES-SET IT TO END CMPB (R4)+,#CR ;NEXT CHAR=CR? BNE LFLOOP ;NO CMPB (R4)+,#LF ;YES-CHAR AFTER THAT LF? BNE LFLOOP ;NO DEC R3 ;YES-DECREASE COUNT BNE LFLOOP ;DONE? RTS PC ;YES ;SUBROUTINE SEARCH ;COMPARES TEXT OBJECT WITH PAGE BUFFER STARTING AT PTR. ;RETURNS TO CALL+1 IF MATCH FOUND,CALL+2 IF SEARCH FAILS. ;LEAVES POINTER AFTER LAST CHARACTER CHECKED. LOOKS FOR "ARG" ;NUMBER OF MATCHES BEFORE SUCCESS. SNOHIT: INC PTR ;MOVE POINTER FORWARD ONE AND SEARCH AGAIN SEARCH: MOV PTR,R4 ;R4 POINTS TO DOT MOV OBSTRT,R3 ;R3 POINTS TO OBJECT ADD CBASE,R3 ;R3 NOW ABSOLUTE ADDR OF OBJECT MOV OBLENG,R2 ;R2 CONTAINS OBJ LENGTH SLOOP1: CMP R4,CBSTRT ;END OF BUFFER? BHIS SFAIL ;YES-SEARCH FAILED CMPB (R4)+,(R3)+ ;NO-DOES THIS CHAR MATCH? BNE SNOHIT ;NO DEC R2 ;YES-MORE CHARS IN OBJECT TO MATCH? BEQ SMATCH ;NO-SEARCH SUCCESSFUL BR SLOOP1 ;YES-CHECK THEM SFAIL: ADD #2,(SP) ;BUMP RETURN MOV R4,PTR ;SET PTR RTS PC ;RETURN SMATCH: MOV R4,PTR ;SET PTR DEC ARG ;MORE MATCHES TO FIND? BGT SEARCH ;YES-GET NEXT ONE RTS PC ;NO-DONE ;ROUTINES IOPCHK AND OOPCHK ;TESTS IF INPUT OR OUTPUT FILES OPEN IOPCHK: TSTB INOFLG ;IS INPUT FILE OPEN? IOPCOM: BNE IOPRET ;YES ERROR+14 ;NO-ERROR IOPRET: RTS PC OOPCHK: TSTB OTOFLG BR IOPCOM ;SUBROUTINE BLKEMT ;GETS CHARS FROM INPUT BUFFER, READING BLOCKS AS NECESSARY BLKEMT: TSTB INOFLG ;IS THERE AN INPUT FILE OPEN? BNE E41$ ;YES ERROR+14 ;"FILE NOT OPEN" E41$: TSTB EOFFLG ;EOF SEEN YET? BEQ E46$ ;NO EOFERR: TSTB SRCFLG ;YES-FILE SEARCH IN PROGRESS? BNE E42$ ;YES-SRCH FAIL MSG ERROR+7 ;NO-"EOF" E42$: ERROR+5 ;"SRCH FAIL" E46$: MOV IBPTR,R2 ;R2 POINTS INTO INPUT BUFFER INC IBPTR ;BUMP INPUT POINTER MOVB (R2)+,-(SP) ;SAVE NEXT CHAR ON STACK BIC #177600,(SP) ;STRIP TO 7 BITS CMP R2,#IBUFF2 ;IS INPUT BUFFER 1 EMPTY? BNE E43$ ;NO-CHECK BUFF 2 TSTB EFFLG ;YES-HAS LAST BLOCK OF FILE BEEN READ? BEQ E47$ ;NO E48$: INCB EOFFLG ;YES-SET END OF FILE FLAG FOR READ TST (SP)+ ;POP CHAR OFF STACK RTS PC ;AND RETURN E47$: MOV #IBUFF1,R2 JSR PC,BREAD ;READ NEXT BLOCK BR E45$ ;BACK TO CALLER E43$: CMP R2,#IBEND ;IS BUFFER2 EMPTY BLO E45$ ;NO-RETURN TSTB EFFLG ;YES-HAS LAST BLOCK BEEN READ? BNE E48$ ;YES-SET FLAG AND RETURN MOV #IBUFF2,R2 ;READ BLOCK 2 JSR PC,BREAD MOV #IBUFF1,IBPTR ;RESET INPUT POINTER E45$: MOVB (SP)+,R0 ;CHAR INTO R0 BEQ E46$ ;IGNORE NULLS E44$: CMPB R0,#RUBOUT ;IS CHAR A RUBOUT? BEQ E46$ ;YES-IGNORE IT .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C CMPB R0,#CNTRLZ BNE OUT01 INCB EFFLG INCB EOFFLG .ENDC ;<<<<<<<<<<<<<<<<<<<< OUT01: RTS PC .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R BREAD: JSR PC,BUFZRO ;ZERO THE BUFFER BEFORE READING IT .WAIT 12 ;WAIT FOR LAST BUFFER BCS 2$ ;WAS LAST READ AN ERROR? .READ 12,R2,#400,IBLKNM ;READ 1 BLOCK FROM INPUT FILE INTO BUFFER AT R2 BCS 2$ ;READ ERROR 1$: INC IBLKNM ;BUMP BLOCK NUMBER RTS PC 2$: TSTB ERRWD ;HARDWARE ERROR? BEQ E3$ ERROR+10 ;YES E3$: INCB EFFLG ;EOF-SET LAST BLOCK READ FLAG RTS PC .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C BREAD: JSR PC,BUFZRO MOV R2,RLBUFF ;ENTER BUFF. ADDR. MOV #RLIST,R2 RTST: IOT .BYTE WAITR,0 ;WAIT FOR CT I/O TO COMPLETE + RTST TSTB (R2) ;ERROR? BMI RERR ;YES IOT .BYTE XREAD IDEV: .BYTE 0 ;DEVICE (INIT'D) .WORD RLIST RTS PC ; RERR: BITB #50,(R2) ;FIL. GAP OR CLR. LDR.? BNE EOFR ;YES: END OF FILE ERROR+10 ;HARDWARE ERROR EOFR: INCB EFFLG ;SET LAST BLK. READ FLAG RTS PC ; RLIST: .BYTE 1 ;ST/ERR MUST INIT T0 1 .BYTE 0 RLBUFF: .WORD 0 ;BUFF. ADDR. .ENDC ;<<<<<<<<<<<<<<<<<<<< ;SUBROUTINE BUFZRO ;CLEARS THE 256 WORD BUFFER WHOSE ADDRESS IS IN R2 BUFZRO: MOV R2,-(SP) ;SAVE R2 .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R MOV #400,R1 ;COUNTER INTO R0 .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C MOV #64.,R1 ;COUNTER .ENDC ;<<<<<<<<<<<<<<<<<<<< E70$: CLR (R2)+ ;ZERO LOCATION DEC R1 ;DECREASE COUNT BGT E70$ ;MORE TO GO MOV (SP)+,R2 ;RESTORE R2 RTS PC ;DONE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;; COMMAND SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ADVANCE ;MOVES PTR TO IMPLIED ADR ADVNCE: JSR PC,LINARG ;ADVANCE IS A LINE COMMAND AJCOM: MOV R4,PTR ;SET PTR RTS PC ;RETURN ;JUMP ;MOVES POINTER TO IMPLIED ADR JUMP: JSR PC,CHRARG ;ARG IS A CHAR ARG BR AJCOM ;SET POINTER AND RETURN ;DELETE ;MOVES TEXT AFTER DELETE UP DELETE: JSR PC,CHRARG ;DELETE IS A CHAR COMMAND DKCOM: CMP PTR,R4 ;IS ADR>PTR? BHIS E76$ ;YES MOV R4,R2 ;NO SUB PTR,R4 ;GET # OF CHARS TO DELETE MOV R4,-(SP) ;SAVE # OF DELETED CHARS MOV PTR,R4 ;SET UP DESTINATION BR E75$ ;PREPARE MOVDWN E76$: MOV PTR,R2 SUB R4,R2 ;GET # OF DELETED CHARS MOV R2,-(SP) ;SAVE THAT NUMBER MOV PTR,R2 ;SET UP MOVE E75$: MOV CBEND,R3 ;MOV PB AND CIB MOV R4,PTR ;SET NEW PTR JSR PC,MOVDWN ;DELETE TEXT SUB (SP),CBSTRT ;UPDATE NEW CIB POINTERS SUB (SP),CBEND TSTB MACFLG ;MACRO IN PROGRESS? BNE E74$ ;YES SUB (SP),CBASE ;NO-ADJUST CS POINTER TO REFLECT CIB MOVE E74$: TST (SP)+ ;CLEAN # OF CHARS OFF STACK RTS PC ;KILL ;SAME AS DELETE ONCE ADR IS DETERMINED KILL: JSR PC,LINARG ;KILL IS A LINE COMMAND BR DKCOM ;SAME AS DELETE .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G ;IMMEDIATE MODE COMMAND SUBROUTINES ;ALTM ;SINGLE ALTMODE - RETURNS TO COMMAND STRING MODE ALTM: CLRB SCFLG ;SET IMMEDIATE MODE OFF MOVB #'!,LASTC ;MAKE SURE CR-LF PRINTS JSR PC,CRLF ;PRINT CR-LF TST (SP)+ ;POP OFF RETURN PC JMP ASTER ;GET NEXT COMMAND STRING .ENDC ;<<<<<<<<<<<<<<<<<<<< ;LIST ;OUTPUTS CHARS BETWEEN PTR AND IMPLIED ADR TO TTY LIST: MOV TTY,OUTINS ;SET UP CALL TO TYPE FOR OUTPUT DEVICE MOV TTY+2,OUTINS+2 LWCOM: JSR PC,LINARG ;ARG IS A LINE ARG CMP R4,PTR ;FORWARD OR BACKWARD? BLO E77$ ;BACKWARD MOV R4,R3 ;FORWARD MOV PTR,R4 ;FINAL ADR IN R3 BR L2 E77$: MOV PTR,R3 ;FINAL LIST CHAR IN R3 L2: CMP R4,R3 ;DONE? BEQ LDONE ;YES MOVB (R4)+,R0 ;NO-SET UP CHAR OUTINS: .WORD 0 ;CALL TO OUTPUT ROUTINE GOES HERE .WORD 0 BR L2 ;LOOP LDONE: RTS PC ;OUTPUT CALLS TTY: JSR PC,@#TYPCHAR FILE: JSR PC,@#BLKSTF ;VERIFY ;EQUIVALENT TO 0L,L VERIFY: CLR ARG ;SET ARG TO 0 JSR PC,LIST ;DO A 0 L INC ARG ;SET ARG TO 1 BR LIST ;FOLLOWED BY AN L. LIST WILL RETURN ;BEGIN ;SETS PTR TO START OF PAGE BUFFER BEGIN: MOV PBSTRT,PTR ;SELF-EXPLANATORY RTS PC ;WRITE ;SAME AS A LIST GOING TO FILE BUFFER INSTEAD OF TTY WRITE: TSTB OTOFLG ;IS THERE AN OUTPUT FILE OPEN? BNE E78$ ;YES ERROR+14 ;NO-NO FILE E78$: MOV FILE,OUTINS ;SET FILE STUFFING ROUTINE AS OUTPUT DEV MOV FILE+2,OUTINS+2 BR LWCOM ;SAME AS LIST ;INSERT ;INSERT TEXT OBJECT AT PTR INSERT: JSR PC,TMODE ;GET OBJECT LENGTH IUCOM: MOV SBSTRT,R4 ;START OF SAVE BUFFER IN R4 SUB CBEND,R4 ;SPACE AVAILABLE IS START OF SB-END OF CIB SUB #10,R4 ;MUST LEAVE ROOM FOR EMERGENCY COMMAND STRING CMP OBLENG,R4 ;COMPARE IT TO OBJECT LENGTH BLO E91$ ;THERE IS ROOM ERROR+4 ;"NO ROOM" E91$: MOV CBEND,R3 ;INITIALIZE MOVE LIMITS ADD OBLENG,CBEND ;UPDATE CBEND MOV CBEND,R4 ;INIT DEST FOR MOVUP MOV PTR,R2 ;MAKE ROOM AT PTR JSR PC,MOVUP ;MAKE ROOM FOR INSERT ADD OBLENG,CBSTRT ;UPDATE START OF CIB TSTB MACFLG ;MACRO IN PROGRESS? BNE E92$ ;YES ADD OBLENG,CBASE ;NO-UPDATE COMMAND POINTER E92$: MOV OBSTRT,R4 ;R4 POINTS TO TOBJECT ADD CBASE,R4 ;R4 POINTS TO ABSOLUTE ADDR OF OBJECT E93$: DEC OBLENG ;DEC COUNT BMI E94$ ;FINISHED? MOVB (R4)+,(R3)+ ;NO-INSERT CHAR BR E93$ ;LOOP E94$: MOV R3,PTR ;YES-UPDATE POINTER RTS PC ;CHANGE ;EQUIVALENT TO A DELETE FOLLOWED BY AN INSERT CHANGE: JSR PC,DELETE BR INSERT ;EXCHANGE ;EQUIVALENT TO A KILL FOLLOWED BY INSERT XCHNGE: JSR PC,KILL BR INSERT ;GET ;SEARCHES CURRENT BUFFER-PRINTS ERROR IF NOT FOUND GET: JSR PC,TMODE ;GET SEARCH OBJECT JSR PC,SEARCH ;FIND IT RTS PC ;WE DID ERROR+5 ;WE DIDN'T ;FIND ;SEARCHES CURRENT BUFFER. IF SEARCH FAILS,WRITES CURRENT BUFFER ;READS NEXT,AND TRIES AGAIN FIND: JSR PC,TMODE ;GET SEARCH OBJECT INCB SRCFLG ;SET FLAG SO EOF CAUSES SRCH ERROR E79$: JSR PC,SEARCH ;FIND OBJECT BR PSDONE ;SUCCESSFUL MOV ARG,-(SP) ;SAVE SEARCH ARGUMENT MOV #1,ARG ;WE WANT TO DO A 1N JSR PC,NEXT ;FAILED-GET IN NEXT PAGE MOV (SP)+,ARG ;RESTORE SEARCH ARG BR E79$ ;AND TRY AGAIN ;POSITION ;SEARCHES CURRENT BUFFER. IF SEARCH FAILS,KILLS THIS BUFFER,READS NEXT, ;AND TRIES AGAIN. POSITN: JSR PC,TMODE ;GET TEXT OBJECT INCB SRCFLG ;SET FLAG SO EOF CAUSES SEARCH ERROR E80$: JSR PC,SEARCH ;FIND IT BR PSDONE ;SUCCESSFUL INCB SLSFLG ;FAILURE JSR PC,BEGIN ;PTR TO BEGINNING JSR PC,DELETE ;DO A /D JSR PC,READ ;GET NEXT BR E80$ ;TRY AGAIN PSDONE: RTS PC ;SEARCH IS DONE ;NEXT ;EQUIVALENT TO B /W /D R NEXT: JSR PC,BEGIN ;DO A B INCB SLSFLG ;SET ARG="/" JSR PC,WRITE ;DO A /W JSR PC,DELETE ;DO A /D JSR PC,READ ;DO A R DEC ARG BGT NEXT RTS PC ;RETURN ;LEFT BRACKET (<) ;STORES COMMAND CHAR ADDRESS ON ITERATION STACK,FOLLOWED BY COUNT LFTBRK: CMP ISTACK,#ISTCKE ;STACK FULL? BGT E81$ ;NO ERROR+0 ;YES-"<>" ERROR E81$: MOV CREL,-(ISTACK) ;SAVE CURRENT CS POINTER ON ITERATION STK MOV ARG,-(ISTACK) ;SAVE COUNT RTS PC ;RETURN ;RIGHT BRACKET (>) ;CHECKS COUNT ON TOP OF ITERATION STACK ;IF ZERO,POPS ENTRY OFF STACK AND CONTINUES. ;IF NOT ZERO,MOVES ADR ON STACK INTO CREL RGTBRK: CMP ISTACK,#ISTCKA ;STACK EMPTY? BLO RGTB1 ;NO ERROR+0 ;YES-"<> ERROR" RGTB1: DEC (ISTACK) ;DECREASE ITERATION COUNT BY 1 BLE E82$ ;THIS LOOP DONE? MOV 2(ISTACK),CREL ;NO-RESET CREL TO START OF THIS LOOP RTS PC ;RETURN E82$: CMP (ISTACK)+,(ISTACK)+ ;LOOP DONE-DELETE ITEM FROM STACK RTS PC ;EXECUTE MACRO ;SAVES CURRENT COMMAND STRING POINTER AND STARTS COMMAND LOOP ;WORKING ON MACRO BUFFER EMACRO: INCB MACFLG ;WE ARE STARTING A MACRO CMP MBSTRT,BEND ;IS MACRO BUFFER EMPTY? BLO E83$ ;NO-GO AHEAD ERROR+6 ;YES-MACRO ERROR E83$: MOV CREL,MACR1 ;NO-SAVE CURRENT CS POINTER MOV MBSTRT,CBASE ;POINT COMMAND POINTER TO MACRO BUFFER MOV ARG,MACCNT ;SET UP MACRO COUNT TST (SP)+ ;CLEAN OFF STACK BEFORE STARTING ;NEW LINE.THIS IS CALLED VIA JSR BUT ;DOES NO RTS. JMP COMAND ;EXECUTE MACRO COMMAND STRING ;SAVE ;MOVES CHARS FROM PTR THROUGH ADR INTO SAVE BUFFER SAVE: JSR PC,LINARG ;SAVE IS A LINE COMMAND SUB PTR,R4 ;# OF CHARS TO SAVE MOV PTR,R3 ;START MOVING AT POINTER MOV MBSTRT,R2 SUB R4,R2 ;R2 NOW POINTS TO START OF NEW SAVE BUFFER CMP R2,CBEND ;ENOUGH ROOM? BHI E85$ ;YES ERROR+4 ;"NO ROOM" E85$: MOV R2,SBSTRT ;SET NEW SBSTRT E86$: TST R4 ;DONE? BLE E87$ ;YES MOVB (R3)+,(R2)+ ;SAVE CHAR DEC R4 ;DECREASE COUNT BR E86$ E87$: RTS PC ;FINISHED ;UNSAVE ;INSERTS SAVE BUFFER AT POINTER. IF 0U,ZEROES SAVE BUFFER UNSAVE: TST ARG ;IS ARG=0? BNE E88$ ;NO MOV MBSTRT,SBSTRT ;YES-ZERO SAVE BUFFER RTS PC ;RETURN E88$: MOV #OBLENG,R4 ;R4 POINTS TO OBJECT LENGTH MOV MBSTRT,(R4) SUB SBSTRT,(R4)+ ;LENGTH OF SAVE BUFFER=OBJECT LENGTH MOV SBSTRT,(R4) ;START OF SAVE BUFFER IS START OF TEXT OBJECT SUB CBASE,(R4) ;OBSTART IS THE RELATIVE ADDR OFF THE MOVED CIB TSTB MACFLG ;MACRO IN PROGRESS? BNE E89$ ;YES-INSERT WILL NOT ADD OBLONG TO CBASE SUB OBLENG,(R4) ;INSERT WILL ADD OBLENG TO CBASE AS PART OF NORMAL OPERATION E89$: JMP IUCOM ;DO AN INSERT,TREATING THE SAVE BUFFER ;AS THE TEXT OBJECT ;READ ;INPUTS CHARS TO PAGE BUFFER UNTIL FF OR EOF IS SEEN,OR WE GET ;WITHIN 500 CHARS FROM END AND A CRLF IS SEEN READ: CLRB SRFLG ;CLEAR SUCCESSFUL READ FLAG JSR PC,IOPCHK ;MAKE SURE THERE IS AN INPUT FILE OPEN MOV CBSTRT,-(SP) ;SAVE CURRENT CIB START MOV (SP),R2 MOV CBEND,R3 MOV SBSTRT,R4 ;SET UP MOVE TO OPEN UP PB DEC R4 ;MOVE TO RIGHT BELOW SAVE BUFFER JSR PC,MOVUP ;MAKE ROOM FOR READ MOV R4,-(SP) ;SAVE NEW CIB START MOV CBSTRT,R4 ;FIRST READ CHAR GOES INTO R4 E95$: MOV (SP),R3 ;LAST FREE SPOT IN R3 SUB #12,R3 ;LEAVE ROOM FOR EMERGENCY COMMAND STRING SUB R4,R3 ;ANY ROOM LEFT? BHI E96$ ;YES JSR PC,READRS ;NO-RESTORE BUFFER BEFORE REPORTING ERROR ERROR+4 ;NO ROOM E96$: JSR PC,BLKEMT ;YES-GET CHAR FROM FILE TSTB EOFFLG ;IS IT END OF FILE? BNE E97$ ;YES-EOF MEANS END OF READ MOVB R0,SRFLG ;MARK THIS READ A SUCCESSFUL MOVB R0,(R4)+ ;PUT CHAR INTO BUFFER CMPB R0,#FF ;IS CHAR FF? BEQ E97$ ;YES-READ IS OVER CMP #776,R3 ;NO-ARE WE WITHIN 500 OF END? BLO E95$ ;NO-READ NEXT CHAR CMPB R0,#LF ;YES-IS CHAR LF? BNE E95$ ;NO-GET NEXT CMPB -2(R4),#CR ;YES-WAS LAST CR? BNE E95$ ;NO-GET NEXT ;YES-END READ E97$: JSR PC,READRS ;RESTORE BUFFERS TSTB MACFLG ;MACRO IN PROGRESS? BNE E98$ ;YES ADD R4,CBASE ;NO-UPDATE CS POINTER E98$: TSTB SRFLG ;WAS THERE AT LEAST ONE CHAR IN THIS READ? BNE E99$ ;YES-RETURN TSTB EXFLG ;EXIT IN PROGRESS? BNE E99$ ;YES-DON'T REPORT THE ERROR JMP EOFERR ;NO-EOF ERROR;SRCH FAIL IF SEARCHING E99$: RTS PC READRS: MOV (SP)+,R0 ;SAVE RETURN ADDR IN R0 MOV SBSTRT,R3 DEC R3 ;MOVE FROM RIGHT BELOW SAVE BUFFER MOV (SP)+,R2 ;SET UP MOVE DOWN MOV R4,-(SP) ;SAVE NEW CIB STRT JSR PC,MOVDWN ;SLIDE CIB BACK DOWN MOV (SP)+,R4 SUB (SP)+,R4 ;GET # OF CHARS READ ADD R4,CBSTRT ADD R4,CBEND ;UPDATE CIB POINTERS MOV R0,PC ;RETURN ;MACRO ;PUTS COMMAND MACRO INTO MACRO BUFFER ;0M EMPTIES MACRO BUFFER MACRO: TST ARG ;IS IT 0M? BNE E102$ ;NO-INSERT MACRO MOV BEND,R4 MOV SBSTRT,R2 MOV MBSTRT,R3 JSR PC,MOVUP ;YES-SLIDE SAVE BUFFER UP TO END OF CORE MOV R4,SBSTRT MOV BEND,MBSTRT ;MACRO BUFFER NOW LOGICALLY EMPTY RTS PC E102$: MOV SBSTRT,R2 MOV MBSTRT,R3 MOV CBEND,R4 JSR PC,MOVDWN ;SLIDE SB DOWN,MAKING ROOM FOR INSERT MOV BEND,TMP SUB R4,TMP ;MAX # OF CHARS ALLOWED IN MACRO SUB #10,TMP ;MUST LEAVE ROOM FOR EMERGENCY COMMAND STRING CLR R2 ;ZERO COUNT OF MACRO CHARS INC R1 ;R1 NOW POINTS TO DELIMITER MOVB (R1)+,R3 ;R3 HOLDS DELIMETER CHAR ADD #2,CREL E103$: CMPB (R1),R3 ;FIND SECOND DELIMETER BEQ E106$ ;FOUND IT INC R2 ;NOT FOUND-INCREMENT MACRO CHAR COUNT TSTB (R1)+ ;END OF STRING? BEQ E104$ ;YES-DELIMITER ERROR INC CREL ;NO-BUMP POINTER BR E103$ E104$: JSR PC,E105$ ;RESORE SAVE BUFFER BEFORE REPORTING ERROR ERROR+6 ;NO-DELIMETERS DON'T MATCH E106$: CMP R2,TMP ;IS THERE ENOUGH ROOM FOR THIS MACRO? BLO E107$ ;THERE IS JSR PC,E105$ ;RESTORE SAVE BUFFER BEFORE REPORTING ERROR ERROR+4 ;NO ROOM E107$: MOV BEND,R3 ;R3 POINTS TO END OF MACRO BUFFER CLRB (R3) ;LAST BYTE OF MACRO MUST BE 0 E108$: TST R2 ;DONE? BEQ E109$ ;YES MOVB -(R1),-(R3) ;NO-PUT CHAR IN MACRO BUFF (FROM RIGHT TO LEFT) DEC R2 ;DECREASE COUNT BR E108$ E105$: MOV BEND,R3 ;ON ERROR,ZERO MACRO BUFFER E109$: MOV R3,MBSTRT ;START OF MBUFF CMPB -(R4),-(R4) ;SUBTRACT 2 FROM R4 MOV R4,R3 MOV CBEND,R2 MOV MBSTRT,R4 ;MOVE SAVE BUFFER UP AGAINST MACRO BUFFER DEC R4 ;LAST LOC OF MOVE IS MBSTRT-1 JSR PC,MOVUP MOV R4,SBSTRT ;SET START OF SB RTS PC ;SUBROUTINE FNGET .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;CALLS CSI IN SPECIAL MODE TO CONVERT TEXT OBJECT INTO ;RAD50 FILE DESCRIPTOR FNGET: MOV R0,-(SP) ;SAVE R0 (IT WILL BE DESTROYED BY TMODE) MOV #CSIBLK,R2 ;R2 -> WORK AREA FOR CSI MOV #CSISTR,R3 ;R3 -> INPUT STRING AREA JSR PC,TMODE ;ISOLATE TEXT OBJECT CMP OBLENG,#23 ;FILE DESCRIPTOR MORE THAN 19 CHARS? BGT E55$ ;YES-ERROR MOV OBSTRT,R4 ;RELATIVE START OF TEXT STRING ADD CBASE,R4 ;MAKE IT ABSOLUTE MOV R3,-(SP) ;SAVE ADDRES OF CSI AREA E56$: DEC OBLENG ;MORE CHARS IN NAME? BLT E57$ ;NO MOVB (R4)+,(R3)+ ;COPY NAME INTO CSI AREA BR E56$ E57$: MOVB #LBRCKT,(R3)+ ;END WITH "<" CLRB (R3)+ MOV (SP)+,R3 .CSISPC R2,#DEFEXT,R3 ;SPECIAL MODE CSI BCC E53$ ;IF ERROR,NAME MUST BE ILLEGAL E55$: ERROR+16 ;ILLEGAL NAME E53$: TST (SP)+ ;MAKE SURE THERE WERE NO SWITCHES BNE E55$ ;THERE WERE MOV #4,R3 ;DESCRIPTOR IS 4 WORDS LONG MOV (SP)+,R0 ;RESTORE ADDRESS OF FILE BLOCK E54$: MOV (R2)+,(R0)+ ;PUT DESCRIPTOR IN NAME BLOCK DEC R3 ;DONE? BGT E54$ ;NO MOV (R2)+,FILENG ;REMEMBER LENGTH FOR ENTER RTS PC ;YES-RETURN .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C FNGET: CLRB @DEVPTR ;DFLT. DEV. = CT0 CLR (PC)+ ;SHOW NO DEV. YET DFLG: 0 ;DEVICE FLAG MOV R0,-(SP) ;SAVE NAME PTR JSR PC,TMODE ;ISOLATE TEXT OBJECT CMP OBLENG,#14. ;14 CHARS. MAX. BGT ILLNMER MOV OBSTRT,R4 ;REL. TEXT STR. ST. ADD CBASE,R4 ;NOW, ABSOL. MOV R4,(PC)+ ;SAVE STR PTR STRPTR: .WORD 0 ;STRING PTR. TRYNM: MOV (SP),R0 ; ; ; --GETNAME ; MOV PC,R3 ;EXTEN. FLAG - NOW ON NAME MOV #3,R2 ;NAME CNT. = 6 DOEXT: ADD #3,R2 ;EXTEN. CNT. = 6 MORE: JSR PC,CHKC ;CHK. CHAR BPL NONALNM ;NOT ALPHANUM. DEC R2 BLT EXITA2 ;CHA. AFTER CNT OF 0 ILL. MOVB R1,(R0)+ ;INSERT CHAR. OF NAME BR MORE NONALNM:CMP #6,R2 ;NON ALPHA-NUM. CAN'T BEQ MRKNULL ; BE FIRST TST R2 BR CHKPAD ;SEE IF NEC. TO PAD. W/ SPACES PADSP: MOVB #SPACE,(R0)+ DEC R2 CHKPAD: BNE PADSP CMPB R1,#SPACE ;WAS NON- A/H CHAR. SPACE? BNE NOTSP ;NO TST R3 ;EXTENSION? BEQ EXITA1 ;IT'S DONE: ET OUT CMPB (R4)+,#'. ;'.'AFTER SP.? BNE MRKNULL ;MAKE NULL EXT. AND LEAVE MOV R4,R2 ;CURR. CHAR. PTER. - WANT TO SUB (SP),R2 ; GET CHARS. FROM HERE TO ST. O SUB #7,R2 ; NAME. IF .LT. 6 CHARS. BLE MRKDOT ; BEFORE '.', GOOD NAME BR MRKNULL ; NOTSP: TST R3 ;EXT. DONE? BEQ EXITA0 ;YES: PT. AT NEXT CHAR. CMPB R1,#'. ;WAS IT '.'? BNE MRKNULL ;BACK W/ PTR. AT ILL. CHAR. MRKDOT: CLR R3 ;SHOW GOING TO DO EXT. BR DOEXT EXITA2: TST R3 ;ON ILL. CHAR. W/ NO EXT. BEQ EXITA0 ; SEEN CLR 1ST EXT.BYTE MRKNULL:CLRB (R0)+ ;MARK NULL NAME OR EXT. EXITA0: DEC R4 ;PT. TO 1ST NON-BLANK CHAR. EXITA1: MOV (SP),R0 ;ST-OF NAME JSR PC,CHKC ;CHK. THAT CHAR. BCS DODEV ;COLON BVC ILLNMER ;NOT ALTMODE SO, ERROR TSTB (R0) ;NAME NULL? BEQ ILLNMER ;YES: ILL. TSTB 6(R0) ;EXT NULL? BNE EXIT10 ;NO MOV #"PA,6(R0) ;INSERT DFLT. EXT. MOVB #'L,8.(R0) EXIT10: CMPB IDEV,ODEV BNE OUT CMP #INBLK,R0 ;INPUT NOW? BEQ INCHK ;YES CLRB INOFLG ;NO: CANCEL INPUT BR OUT CNFLCT: ERROR+17 ;I/O CHAN CONFLICT INCHK: TSTB OTOFLG BNE CNFLCT OUT: TST (SP)+ RTS PC ; ; --DODEV ; DODEV: TST DFLG ;BEEN HERE BEFRE? BNE ILLNMER ;YES: CAN'T DO DEV. TWICE INC DFLG ;SHOW DEVICE SEEN MOV STRPTR,R4 ;PTR. TO ST. OF STRING MOV #-2,R3 ; GETDN: CLR R2 ;WILL ACCUM. CHARS. INC R3 ;ONLY GO THRU GETDN TWICE BGT ILLNMER SECHAR: MOVB (R4)+,R1 ;GET CHAR BIS R1,R2 SWAB R2 BEQ SECHAR ;GET 2 CHARS. CMP R2,#"CT BEQ GETDN ;NOW GET NUM CMP R2,#"0: ;DEV. = 0? BEQ TRYNM ;YES INCB @DEVPTR ;MAKE UNIT #1 CMP R2,#"1: ;UNIT #1? BEQ TRYNM ILLNMER:ERROR+16 ;ILL. NAME ERROR ; ; CHKC - CHECK CHAR. ; CHKC: MOV #10,-(SP) ;WILL BE PS MOVB (R4)+,R1 BEQ ALTOUT CMPB #33,R1 ;ANY ALTMODE FINISHES THINGS BEQ ALTOUT CMPB #175,R1 BEQ ALTOUT CMPB #176,R1 BEQ ALTOUT CMPB #'0,R1 BGT ERR CMPB #72,R1 BEQ COLOUT BGT AN CMPB #'A,R1 BGT ERR CMPB #'Z,R1 BGE AN ERR: ASR (SP) ;4 SHIFTS='CCC' COLOUT: ASR (SP) ;3 SHIFTS='SEC' ALTOUT: ASR (SP) ;2 SHIFTS='SEV' ASR (SP) AN: MOV (SP)+,@#PS ;NEW STATUS RTS PC .ENDC ;<<<<<<<<<<<<<<<<<<<< ;EDIT VERSION ;TYPES VERSION # AND CREATION DATE ON TTY EVERS: JSR PC,CRLF .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R .PRINT #VMSG .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C MOV R3,-(SP) MOV #VMSG,R3 JSR PC,EPRINT MOV (SP)+,R3 .ENDC ;<<<<<<<<<<<<<<<<<<<< RTS PC ;TYPE THE MESSAGE AND RETURN VMSG: .ASCII !V02-12 ! .BYTE 0 .EVEN .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;EDIT LOWER ;ENABLES UPPER/LOWER CASE EDITING BY SETTING UPPER/LOWER CASE BIT IN JSW ELOWER: BIS #ULCASE,@#JOBSTAT ;SET UL CASE BIT IN JSW (BIT 14) RTS PC ;EDIT UPPER ;SETS EDITING TO UPPER CASE ONLY BY CLEARING UPPER/LOWER CASE BIT IN JSW EUPPER: BIC #ULCASE,@#JOBSTAT ;TURN OFF UL CASE RTS PC .ENDC ;<<<<<<<<<<<<<<<<<<<< ;START ROUTINE ;CALCULATES HOW MUCH CORE IS AVAILABLE ,SETS THE TOP,THEN ASKS ;FOR FIRST COMMAND. .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R RESTRT: .SRESET ;RE-ENTRY ADDRESS START: MOV EDSTRT,SP ;STACK START MOV #ERRORT,@#TRAPV ;SET UP TRAP VECTOR CLR @#TRAPV+2 MOV #NEGFLG,R0 1$: CLR (R0)+ ;LOOP TO INITIALIZE ALL FLAGS TO 0 CMP R0,#EQLENG BLOS 1$ ;BRANCH IF NOT DONE MOV #177776,R0 ;WANT ALL WE CAN GET .SETTOP CMP R0,#EDEND+1000 ;NEED THIS MUCH BHI E117$ ;BR IF WE GOT IT .PRINT #OVLFLO ;NOT ENOUGH .EXIT OVLFLO: .ASCIZ /?OVR COR?/ E117$: MOV #USRSWP,@#USRADD ;USR SWAPS HERE MOV #BEND,R1 ;DYNAMIC PTRS START ADDR MOV R0,(R1)+ ;SET BEND MOV R0,(R1)+ ;SET MBSTRT MOV R0,(R1)+ ;SET SBSTRT TST (R1)+ ;SKIP CBEND MOV EDTOP,R0 ;TOP OF EDITOR MOV R0,(R1)+ ;SET CBSTRT MOV R0,(R1) ;SET PBSTRT MOV R0,PTR ;SET PTR .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G TST CBEND ;FIRST TIME THROUGH BNE 2$ ;NO, SKIP INCB FTFLG ;SET FIRST TIME SW 2$: CMP EDSPLY,ICERR ;CAN'T USE ED BEQ NDSP ;THEN FORGET DISPLAY INIT JSR PC,DREST ;FIX TYPCHAR FOR RESTARTS .UNLNK ;TRY UNLINK IN CASE OF RESTART .LNKRT ;LINK TO MONITOR BMI NDSP ;CAN'T LINK - NOW BCC 1$ ;SCROLLER NOT ACTIVE? .UNLNK ;IT'S NOT, FORGET DISPLAY BR NDSP ;CONTINUE INIT 1$: INCB DSFLG ;YES - LET'S USE DISPLAY JSR PC,INDSP ;INIT DISPLAY NDSP: .ENDC ;<<<<<<<<<<<<<<<<<<<< BIS #30000,@#JOBSTAT ;JOB RESTARTABLE, TTY SELF SERVICE MODE .QSET #IOQ,#3 ;INIT I/O Q FOR 3 ENTRIES JMP ASTER ;GET FIRST COMMAND .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G ;EDIT DISPLAY ;SETS UP DISPLAY ROUTINES IF DISPLAY IS AVAILABLE EDSPLY: TSTB DSFLG ;ARE WE CURRENTLY USING DSPLY? BNE 2$ ;YES - RETURN .LNKRT ;LINK TO MONITOR TST R0 ;IS DSPLY THERE? BMI 3$ ;NO - ERROR INCB DSFLG ;SET DSPLAY FLAG ON JSR PC,INDSP ;INIT DISPLAY JSR PC,DUPDAT ;REFRESH DISPLAY 2$: RTS PC ;RETURN 3$: ERROR+12 ;ILLEGAL DEVICE ;EDIT CONSOLE ;DISABLES DISPLAY FUNCTIONS IF ACTIVE AND USES TTY AS OUTPUT DEVICE ECONS: TSTB DSFLG ;CURRENTLY USING DISPLAY? BEQ 1$ ;NO - IGNORE CMD AND RETURN .UNLNK ;UNLINK FROM MONITOR JSR PC,DREST ;FIX TYPCHAR FOR TTY CLRB DSFLG ;MARK DISPLAY GONE 1$: RTS PC ;RETURN .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G SCBUF: .WORD 4 ;NUMBER OF LINES .WORD 140 ;CHANGE IN Y POS. ; ; SUBROUTINE TO INITIALIZE DISPLAY FUNCTIONS ; INDSP: .CLEAR ;INIT DISPLAY HANDLER MOV #DBUFR,DPTR ;INIT DISPLAY FILE CLR DARG ;WITH AN IMMEDIATE JSR PC,DCALL ;DISPLAY RETURN. G1: JSR PC,TSTSCP ;TEST FOR SCOPE SIZE .SCROL #SCBUF ;ADJUST SCROLLER PARMS .INSRT #DSFILE ;INSERT DISPLAY FILE .TTYOUT #LF ;PRINT LF TO CLEAR SCROLLER RTS PC ;RETURN ; ; SUBROUTINE TO UPDATE THE DISPLAY BUFFER ; DUPDAT: .STOP ;STOP FILE TO WORK ON IT MOV #DBUFR,DPTR ;POINT TO DISPLAY BUFR MOV DSPLY,E120$ ;SET UP TO DIVERT TTY MOV DSPLY+2,E120$+2 ;OUTPUT TO DISPLAY BUFR MOV DSPLY,E122$ MOV DSPLY+2,E122$+2 MOV DSPLY,E128$ MOV DSPLY+2,E128$+2 MOV TTY,OUTINS ;SET UP LWCOM CODE MOV TTY+2,OUTINS+2 ;TO USE TYPCHAR ROUTINE MOV #10,E127$ ;RESET TAB COUNTER CLRB SLSFLG ;CLEAR "/" SEEN FOR LIST CMD MOV DSARG,ARG ;PREPARE TO SIMULATE INCB NEGFLG ;A MINUS JSR PC,LWCOM ;L COMMAND MOV #CUR1,R1 ;SETUP CURSOR ADJUSTMENT MOV #100,R2 ;BIT MASK FOR VECTOR WORD CMP #15,R0 ;LAST CHAR OUT A CR? BEQ 1$ ;YES - MINUS CURSOR BIC R2,(R1)+ ; POSITIVE CURSOR ;CLEAR MISVY IN FIRST VECT WORD 1$: BIS R2,(R1)+ ;SET MISVY (MINUS CURSOR) BIC R2,(R1) ;CLEAR MISVY MOV #CURSOR,DARG ;INSERT CALL TO CURSOR JSR PC,DCALL ;INTO DISPLAY BUFR. MOV DSARG,ARG ;PREPARE TO SIMULATE CLRB NEGFLG ;A PLUS JSR PC,LWCOM ;L COMMAND. CLR DARG ;INSERT A DRET 0 JSR PC,DCALL ;INTO DISPLAY BUFR. JSR PC,DREST ;RESTORE TYPCHAR TO TTYOUT .START ;START DISPLAY RTS PC DREST: MOV TTYOUT,E120$ ;RESTORE .TTYOUT TO MOV TTYOUT+2,E120$+2 ;TYPCHAR ROUTINE MOV TTYOUT,E122$ MOV TTYOUT+2,E122$+2 MOV TTYOUT,E128$ MOV TTYOUT+2,E128$+2 RTS PC ; ; SUBROUTINE TO INSERT A CHARACTER INTO DISPLAY BUFFER. ; DINSRT: CMP DPTR,#DBUFE ;PAST BUFFER END? BHIS 1$ ;YES, GO EXIT MOVB R0,@DPTR ;NO, INSERT THE CHAR. INC DPTR ;AND BUMP POINTER. 1$: RTS PC ; ; SUBROUTINE TO INSERT A DISPLAY SUBROUTINE CALL INTO DISPLAY FILE ; DCALL: BIT #1,DPTR ;WORD BOUNDARY? BEQ 1$ ;YES CLR R0 ;NO, INSERT A NULL JSR PC,DINSRT ;TO ALIGN POINTER 1$: CMP DPTR,#DBUFE-3 ;ROOM IN BUFFER FOR CALL? BHIS 2$ ;NO - EXIT MOV #DJSR,@DPTR ;NOW INSERT A CALL ADD #2,DPTR ;BUMP THE POINTER MOV DARG,@DPTR ;INSERT SUBR. ADDRESS ADD #2,DPTR ;BUMP POINTER 2$: RTS PC ; DARG: .WORD 0 ;ADDR. OF DISPLAY SUBR DPTR: .WORD DBUFR ;INIT POINTER TO DBUFR DSPLY: JSR PC,@#DINSRT ;CALL TO A ROUTINE TO ;INSERT ACHAR. INTO DISPLAY BUFR. TTYOUT: .TTYOUT ;TTYOUT CODE FOR SETUP DSARG: .WORD 12 ;LINE ARG. FOR L COMD. .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;SUBROUTINE FETCH ;LOADS DEVICE HANDLER INTO CORE IF NOT THERE ALREADY ;EXPECTS R2 TO POINT TO FILE DESCRIPTOR BLOCK FETCH: .DSTATUS #CORADD,R2 ;GET INFO ON HANDLER BCC 2$ ;BRANCH IF NO ERROR 1$: ERROR+12 ;ILLEGAL DEVICE 2$: TST CORADD+4 ;ALREADY RESIDENT? BNE FETCHR ;YES - RETURN INC CORADD+2 ;MAKE SURE IT FITS MOV CORADD+2,R4 ;GET HANDLER SIZE MOV SBSTRT,R3 ;FREE AREA TOP SUB CBEND,R3 ;MINUS BOTTOM SUB #10,R3 ;LESS EMERGENCY CMD SPACE CMP R4,R3 ;IS HNDLR SMALLER THAN AVAILABLE? BLOS 3$ ;YES - GO INSERT IT ERROR+4 ;'N O R O O M' 3$: TST HAND1N ;AREA 1 IN USE? BNE 5$ ;YES - USE AREA 2 MOV R2,R0 ;SAVE R2 JSR PC,SETUP1 ;SET UP PARMS FOR MOVE JSR PC,MUP ;MOVE PB AND CIB TO MAKE HOLE MOV R0,R2 ;RESTORE R2 .FETCH EDTOP,R2 ;GET THE HANDLER INTO HOLE BCC 4$ ;BRANCH IF NO ERROR JSR PC,CLOSE1 ;CLOSE AREA 1 HOLE ERROR+12 ;ILLEGAL DEVICE 4$: MOV (R2),HAND1N ;REMEMBER THE DEVICE NAME IN AREA 1 BR FETCHR ;EXIT 5$: MOV R2,R0 ;SAVE R2 NEG R4 ;SET TO DECREASE PTRS JSR PC,SETUP2 ;SET UP PARMS FOR MOVE DOWN JSR PC,MDWN ;MOVE SB AND MB DOWN TO MAKE HOLE MOV BEND,R3 ;GET ADDRESS OF HOLE BOTTOM INC R3 ;MAKE IT WORD BOUNDARY BIC #1,R3 ;ADDRESS TO LOAD HANDLER MOV R0,R2 ;RESTORE R2 .FETCH R3,R2 ;GET HANDLER BCC 6$ ;BRANCH IF NO ERROR JSR PC,CLOSE2 ;CLOSE AREA 2 HOLE ERROR+12 ;ILLEGAL DEVICE 6$: MOV (R2),HAND2N ;REMEMBER DEVICE NAME IN AREA 2 BR FETCHR ;EXIT UNSET1: MOV CORADD+2,R4 ;GET HANDLER (HOLE) SIZE NEG R4 ;SET TO DECREASE PTRS SETUP1: MOV PBSTRT,R2 ;BOTTOM ADDR OF AREA TO BE MOVED ADD R4,PBSTRT ;UPDATE BOTTOM ADDR ADD R4,CBSTRT ;UPDATE CIB ADDR ADD R4,PTR ;UPDATE CIB PTR TSTB MACFLG ;ARE WE IN A MACRO? BNE 1$ ;YES - CONTINUE ADD R4,CBASE ;UPDATE CMD STRING PTR 1$: MOV CBEND,R3 ;TOP ADDR OF AREA TO BE MOVED ADD R4,CBEND ;UPDATE TOP ADDR RTS PC ;RETURN UNSET2: MOV CORADD+2,R4 ;GET HANDLER (HOLE) SIZE SETUP2: MOV SBSTRT,R2 ;BOTTOM ADDR OF AREA TO BE MOVED ADD R4,SBSTRT ;UPDATE BOTTOM ADDR MOV BEND,R3 ;TOP ADDR OF AREA TO BE MOVED ADD R4,BEND ;UPDATE TOP ADDR ADD R4,MBSTRT ;UPDATE MB START TSTB MACFLG ;ARE WE IN A MACRO BEQ 1$ ;NO - CONTINUE ADD R4,CBASE ;UPDATE MB PTR 1$: RTS PC ;RETURN CLOSE1: JSR PC,UNSET1 ;SETUP TO ELIMINATE HOLE 1 MDWN: ADD R2,R4 ;MOVE DESTINATION JMP MOVDWN ;CLOSE IT AND RETURN CLOSE2: JSR PC,UNSET2 ;SETUP TO ELIMINATE HOLE 2 MUP: ADD R3,R4 ;MOVE DESTINATION JMP MOVUP ;CLOSE IT AND RETURN ;SUBROUTINE MOVUP ;MOVES THE BYTES FROM R2 THROUGH R3 TO HIGHER CORE,WORKING DOWN. ;STARTS AT R3,WORKS TO R2. HIGHEST ADDR OF MOVE IS IN R4 MOVUP: INC R3 ;BACK UP IN PREPARING FOR DECREMENT INC R4 ;DITTO E65$: CMP R3,R2 ;DONE? BLOS E66$ ;YES-RETURN MOVB -(R3),-(R4) ;NO-MOVE CHARACTER BR E65$ ;AND LOOP E66$: RTS PC ;SUBROUTINE MOVDWN ;MOVES THE BYTES FROM R2 THROUGH R3 TO LOWER CORE,WORKING UP ;STARTS AT R2,WORKING UP TO R3. LOWEST ADDR OF MOVE IS IN R4 MOVDWN: CMP R2,R3 ;DONE? BHI E67$ ;YES-RETURN MOVB (R2)+,(R4)+ ;NO-MOVE THE CHARACTER BR MOVDWN ;LOOP E67$: RTS PC FETCHR: RTS PC ;SUBROUTINE RELEAS ;RELEASES HANDLER IF NO LONGER NEEDED ;R2 POINTS TO HANDLER NAME RELEAS: .DSTATUS #CORADD,#INBLK ;FIND OUT WHAT INPUT DEVICE IS MOV CORADD,-(SP) ;REMEMBER IT .DSTATUS #CORADD,#OUTBLK;FIND OUT WHAT OUTPUT DEVICE IS CMP CORADD,(SP)+ ;ARE THEY THE SANE BEQ 1$ ;YES - CAN'T RELEASE HANDLER .DSTATUS #CORADD,R2 ;GET LENGTH OF HANDLER INC CORADD+2 ;ACCOUNT FOR BOUNDARY ROUNDUP CMP (R2),HAND1N ;IS THIS HANDLER IN AREA 1? BNE 2$ ;NO-TRY AREA 2 CLR HAND1N ;YES-MARK AREA 1 FREE .RELEAS R2 ;RELEASE HANDLER JSR PC,CLOSE1 ;RECLAIM HANDLER SPACE 1 1$: RTS PC 2$: CMP (R2),HAND2N ;IS HANDLER IN AREA 2? BNE 1$ ;NO-MUST BE SYSTEM HANDLER,SO LEAVE IT CLR HAND2N ;YES-MARK AREA 2 FREE .RELEAS R2 ;RELEASE HANDLER JSR PC,CLOSE2 ;RECLAIM HANDLER SPACE 2 BR 1$ .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;SUBROUTINE EBCLOSE ;FORCES OUT LAST BUFFER,THEN ;IF AN EDIT BACKUP IS IN PROGRESS,CLOSES THE INPUT FILE, ;RENAMING IT TO FILE.BAK,THEN CLOSES OUTPUT FILE. EBCLOS: TSTB OTOFLG ;IS AN OUTPUT FILE OPEN? BEQ E72$ ;NO-DON'T BOTHER TO WRITE JSR PC,WFORCE ;FORCE OUT LAST BUFFER LOAD .WAIT 13 ;WAIT FOR LAST BUFFER TO BE WRITTEN BCS BW1$ ;WRITE ERROR E72$: TSTB EBFLG ;IS AN EDIT BACKUP IN PROGRESS? BNE 1$ ;YES RTS PC ;NO-RETURN 1$: .LOCK ;FREEZE USR IN CORE .CLOSE 12 ;CLOSE INPUT FILE MOV #BAK,OUTBLK+6 ;PREPARE NAME BLOCKS FOR RENAME .RENAME 12,#INBLK ;RENAME INPUT FILE TO X.BAK .CLOSE 13 ;CLOSE OUTPUT FILE .UNLOCK ;RELEASE USR FROM CORE CLRB OTOFLG ;MARK OUTPUT FILE CLOSED CLRB INOFLG ;MARK INPUT FILE CLOSED CLRB EBFLG ;NO EB IN PROGRESS ANY MORE RTS PC ;RETURN .ENDC ;<<<<<<<<<<<<<<<<<<<< ;SUBROUTINE WFORCE ;WRITES LAST OUTPUT BUFFER INTO OUTPUT FILE,FOLLOWED BY A CTRL/Z WFORCE: .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C MOV #CNTRLZ,R0 ;PUT IN '^Z' AT FILE END JSR PC,BLKSTF .ENDC ;<<<<<<<<<<<<<<<<<<<< CMP OBPTR,#OBUFF2 ;WHICH BUFFER IS CURRENT POINTER IN? BHIS E71$ ;IN BUFFER 2 CMP OBPTR,#OBUFF1 ;IF BUFFER IS EMPTY,WE DON'T WANT IT BEQ E73$ BR BLKST8 ;IN BUFFER 1,SO WRITE IT AN RETURN E71$: BNE BLKST2 ;IF BUFFER NOT EMPTY,WRITE BUFF2 AND RETURN E73$: RTS PC ;SUBROUTINE BLKSTF ;PUTS CHARS IN OUTPUT BUFFERS, CALLING WRITE WHEN A BUFFER IS FULL BLKSTF: TSTB OTOFLG ;IS AN OUTPUT FILE OPEN? BNE BLKST7 ;YES ERROR+14 ;"FILE NOT OPEN" BLKST7: MOV OBPTR,R2 ;R2 POINTS INTO OUTPUT BUFFER INC OBPTR ;BUMP OUTPUT POINTER MOVB R0,(R2)+ ;PUT CHAR IN OUTPUT BUFFER CMP R2,#OBUFF2 ;IS BUFFER 1 FULL? BNE BLKST1 ;NO-CHECK BUFFER 2 BLKST8: MOV #OBUFF1,R2 ;YES-WRITE BUFFER 1 MOV #OBUFF2,-(SP) ;REMEBER TO ZERO BUFFER 2 BEFORE USING JMP BWRITE ;AND RETURN BLKST1: CMP R2,#OBEND ;IS BUFFER 2 FULL? BLO BLKST3 ;NO - RETURN BLKST2: MOV #OBUFF2,R2 ;WRITE BLOCK 2 JSR PC,BWRIT1 MOV #OBUFF1,OBPTR ;MOVE POINTER TO START OF BUFF1 BLKST3: RTS PC .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R BWRIT1: MOV #OBUFF1,-(SP) ;ZERO BUFF1 BEFORE USING BWRITE: .WAIT 13 ;WAIT FOR LAST WRITE BCS BW1$ ;WATCH FOR ERROR ON LAST WRITE .WRITE 13,R2,#400,OBLKNM;WRITE 1 BLOCK INTO OUTPUT FILE . BCS BW1$ ;ERROR INC OBLKNM ;WRITE SUCCESSFUL SO BUMP BLK# MOV (SP)+,R2 ;PUT ADDR OF BUFFER TO CLEAR IN R2 JSR PC,BUFZRO ;CLEAR BUFFER RTS PC BW1$: TSTB ERRWD ;IS IT EOF BEQ 2$ ;YES ERROR+10 ;"HARDWARE ERROR" 2$: ERROR+11 ;"FILE FULL" .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C BWRIT1: MOV #OBUFF1,-(SP) ;NEW BUFF. BWRITE: IOT .BYTE WAITR,0 ;WAIT ON MAIN BUFF. + BWRITE ;BUSY TSTB WLIST ;END OF TAPE DETECTED? BPL ITSOK ;NOPE JSR PC,CNTINR ;YUP-CLOSE FILE-OPEN NEW ONE MOVB ODEV,ODEV1 ;REWRITE BLOCK THAT FAILED IOT .BYTE XWRITE ODEV1: .BYTE 0 .WORD WLIST BR BWRITE ;GO WAIT FOR IT TO FINISH ITSOK: MOV R2,WLBUFF ;CURR. BUFF IOT .BYTE XWRITE ;WRITE BUFF. ODEV: .BYTE 0 ;DEVICE .WORD WLIST MOV (SP)+,R2 ;2ND BUFF. JSR PC,BUFZRO ;CLR. IT RTS PC ; WLIST: .BYTE 1 ;ST/ERR: MUST INIT. TO 1 .BYTE 0 WLBUFF: .WORD 0 ;BUFF. ADDR. .ENDC ;<<<<<<<<<<<<<<<<<<<< ;EDIT READ ;PREPARES NEW FILE FOR INPUT EREAD: CLRB INOFLG ;THERE IS NOW NO INPUT FILE OPEN .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R JSR PC,EBCLOSE ;IF EB OPEN, CLOSE IT OUT .CLOSE 12 ;CLOSE ANY OPEN INPUT FILE MOV #INBLK,R2 JSR PC,RELEAS ;RELEASE OLS INPUT HANDLER MOV #INBLK,R0 JSR PC,FNGET ;GET NAME FOR NEW FILE MOV #INBLK,R2 .LOCK ;LOCK USR IN CORE JSR PC,FETCH ;FETCH NEW INPUT HANDLER .LOOKUP 12,#INBLK ;IT IS ER-USE LOOKUP BCC E111$ ERROR+13 ;NO FILE E111$: .UNLOCK ;CHASE USR OUT OF CORE .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C MOVB #1,RLIST ;INIT. RD. LIST ST/ERR MOV #INBLK,R0 MOV #IDEV,DEVPTR JSR PC,FNGET ;NAME INTO INBLK MOVB IDEV,SKCHAN IOT .BYTE 10 ;SEEK SKCHAN: .BYTE 0 ;CHANNEL .WORD SKLIST ;ARG LIST .ENDC ;<<<<<<<<<<<<<<<<<<<< CLR IBLKNM ;START BLOCK 0 CLRB EFFLG ;CLEAR LAST BLOCK READ FLAG CLRB EOFFLG ;CLEAR END OF FILE MOV #IBUFF1,R2 JSR PC,BREAD ;DO INITIAL READS TO FILL MOV #IBUFF2,R2 JSR PC,BREAD INCB INOFLG ;MARK OPEN MOV #IBUFF1,IBPTR ;INIT INPUT BUFFER POINT RTS PC .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C ; SKLIST: .BYTE 0 ;ST/ERR .BYTE 2 ;MODE: UNFORM. ASCII .WORD 0,0 ;UNFORM. ACCESS + HDRBUF + INBLK ;NAME + SKERR ; HDRBUF: .=.+32. ;HDR. SCRATCH SPACE ; SKERR: BITB #40,SKLIST ;ST/ERR - BLK. CHK? BEQ FNFND ;NO: FILE NOT FND. ERROR+10 ;HARDWARE ERROR FNFND: ERROR+13 ;NO FILE .ENDC ;<<<<<<<<<<<<<<<<<<<< ;EDIT WRITE ;PREPARES NEW FILE FOR OUTPUT .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R EWRITE: TSTB OTOFLG ;IS ANY OUTPUT FILE OPEN? BEQ EWRIT3 ;NO JSR PC,EFILE1 ;CLEAN UP ANY OPEN FILE EWRIT3: MOV #OUTBLK,R0 JSR PC,FNGET ;GET NEW NAME FOR OUTPUT EWRIT5: MOV #OUTBLK,R2 .LOCK ;LOCK USR IN CORE JSR PC,FETCH ;GET NEW OUTPUT HANDLER .ENTER 13,#OUTBLK,FILENG;OPEN OUTPUT FILE BCC E100$ ;ERROR? .CLOSE 13 ;YES-CLOSE OUTPUT FILE ERROR+15 ;MUST BE FULL DIRECTORY .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C EWRITE: TSTB OTOFLG BEQ EWRIT3 JSR PC,EFILE1 EWRIT3: MOV #OUTBLK,R0 MOV #ODEV,DEVPTR JSR PC,FNGET MOVB ODEV,ENTCHAN REDO: MOV #ENTERR,ERRAD MOV #OBDATE,R2 ;ZERO DATE TO GET CLR (R2)+ ; CURR. ONE IN CLR (R2)+ CLR (R2)+ IOT .BYTE 7 ;ENTER ENTCHAN:.BYTE 0 .WORD ENTLIST .ENDC ;<<<<<<<<<<<<<<<<<<<< E100$: .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R .UNLOCK ;RELEASE USR .ENDC ;<<<<<<<<<<<<<<<<<<<< MOV #OBUFF1,R2 JSR PC,BUFZRO MOV #OBUFF2,R2 ;ZERO OUTPUT BUFFERS BEFORE USING THEM JSR PC,BUFZRO CLR OBLKNM ;START AT BLOCK 0 INCB OTOFLG ;OUTPUT FILE IS OPEN MOV #OBUFF1,OBPTR ;INITIALIZE OUTPUT POINTER RTS PC ;RETURN .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C ENTLIST:.BYTE 0 ;ST/ERR .BYTE 2 ;MODE: UNFORM. ASCII .WORD 0,0 + HDRBUF + OUTBLK ERRAD: .WORD ENTERR + CNTINR ; ENTERR: BIT #40,ENTLIST BNE HRDWER ;HRDW ERR. BIT #100,ENTLIST BNE TF ;TAPE FULL HALT ;CAN'T HAPPEN HRDWER: ERROR+10 TF: ERROR+20 ;TAPE FULL ; CNTINR: MOVB #-1,ENTLIST ;TO PROMP MOVB ODEV,ECH MOV #ENTERR,ERRAD MOVB ODEV,CNUM ;CLOSE FILE IOT .BYTE 6 CNUM: .BYTE 0 .WORD .+2 CLRB OTOFLG ;OUT FILE NO LONGER OPEN IOT .BYTE 7 ;ENTER ECH: .BYTE 0 .WORD ENTLIST INCB OTOFLG ;OUT FILE OPEN RTS PC .ENDC ;<<<<<<<<<<<<<<<<<<<< ;EXIT ;FLUSHES REST OF INPUT FILE THROUGH AND EXITS TO MONITOR EXIT: INCB EXFLG ;MARK EXIT IN PROGRESS TSTB OTOFLG ;IS THERE AN OUTPUT FILE OPEN? BNE E115$ ERROR+14 ;NO-"NO FILE" E115$: TSTB INOFLG ;IS THERE AN INPUT FILE OPEN? BEQ E116$ ;NO-JUST WRITE THIS BUFFER E114$: TSTB EOFFLG ;EOF YET? BNE E116$ ;YES-DONE JSR PC,NEXT ;NO-DO A NEXT BR E114$ E116$: JSR PC,BEGIN INCB SLSFLG JSR PC,WRITE ;DO ONE LAST B/W TO OUTPUT LAST PAGE JSR PC,EFILE ;YES-DO AN END FILE CLRB EXFLG ;EXIT NO LONGER IN PROGRESS .IFNDF NODISP ;>G>G>G>G>G>G>G>G>G>G TSTB DSFLG ;IS DISPLAY HDWRE ACTIVE BEQ 1$ ;NO - SKIP DISPLAY COMMANDS .UNLNK ;UNLINK FROM MONITOR 1$: .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R MOV SP,R0 ;DO A SOFT EXIT TO ALLOW RE-ENTER .EXIT ;EXIT TO MONITOR .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C TSTB @#KBLRES BEQ RBOOT JMP @KBLADR RBOOT: MOV #CCMES,R3 ;PROMPT USER TO MOUNT SYS. CT JSR PC,EPRINT IOT .BYTE XREAD,KEYBRD ;WAIT FOR A RESPONSE + TTINBUF XY: BITB #200,TTST ;GOT IT YET? BEQ XY ;NO CLR PC ; CCMES: .ASCII /^C?/ .BYTE 0 .EVEN .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;END FILE ;CLOSES OUTPUT FILE EFILE: JSR PC,OOPCHK ;MAKE SURE AN OUTPUT FILE IS OPEN EFILE1: JSR PC,EBCLOS ;CLOSE ACTIVE EB IF ANY AND FORCE OUT LAST BLOCK .LOCK ;LOCK USR IN CORE .CLOSE 13 ;CLOSE OUTPUT FILE CLRB OTOFLG ;MARK OUTPUT NOT OPEN MOV #OUTBLK,R2 JSR PC,RELEAS ;FREE OUTPUT HANDLER .UNLOCK ;CHASE USR BACK OUT RTS PC .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C EFILE: JSR PC,OOPCHK EFILE1: JSR PC,WFORCE MOVB ODEV,CLSCHAN IOT .BYTE 6 ;CLOSE CLSCHAN:.BYTE 0 .+2 ;ERROR RTN (NONE POSS.) CLRB OTOFLG RTS PC .ENDC ;<<<<<<<<<<<<<<<<<<<< .IFNDF $CAPS11 ;>R>R>R>R>R>R>R>R>R>R ;EDIT BACKUP ;PREPARES FILE FOR BACKUP RENAME EBCKUP: JSR PC,EFILE1 ;CLOSE ANY CURRENTLY OPEN FILES JSR PC,EREAD ;OPEN INPUT FILE MOV #INBLK,R2 ;R2 POINTS TO INPUT NAME MOV #OUTBLK,R0 ;R0 POINTS TO OUTPUT NAME MOV (R2)+,(R0)+ MOV (R2)+,(R0)+ MOV (R2)+,(R0)+ ;MOVE INPUT NAME INTO OUTPUT NAME BLOCK MOV (R2)+,(R0)+ INCB EBFLG ;MARK EDIT BACKUP IN PROGRESS JMP EWRIT5 ;OPEN OUTPUT FILE BAK=6263 ;.RAD50 /BAK/ .ENDC ;<<<<<<<<<<<<<<<<<<<< CURSOR: SHORTV!INT7!BLKON CUR1: 15!INTX ; 15!INTX!MISVY FOR MINUS CURSOR 15!MISVY ; 15 FOR MINUS CURSOR 3200!INTX 3200!MISVX CHAR!INT4!BLKOFF DRET 0 DSFILE: POINT ;DRAW LINE ABOVE SCROLL AREA 0 200 LONGV!LINE3 MAXX!INTX 0 POINT ;POSITION THE BEAM 0 DSDTOP: 1350 CHAR!INT4!BLKOFF DBUFR: DRET 0 ; THIS CODE IS INITIALIZATION CODE LOCATED IN THE ; DISPLAY BUFFER AND IS EXECUTED ONCE ON START UP. ; IT TESTS FOR SCOPE SIZE AND SETS THE TOP OF THE ; BUFFER DISPLAY TO THE PROPER POSITION. DPC=172000 ;DISPLAY PROGRAM COUNTER DSR=172002 ;DISPLAY STATUS REGISTER TSTSCP: .INSRT #TESTF ;DISPLAY A TEST FILE 1$: TST @#DSR ;DISPLAY STOPPED? BPL 1$ ;NO, KEEP TESTING CMP @#DPC,#G3 ;STOPPED IN RIGHT PLACE? BNE 1$ ;NO, KEEP LOOPING BIT #40,@#DSR ;EDGE FLAG SET? BNE 2$ ;YES, 12" SCOPE MOV #1750,DSDTOP ;SET TOP FOR 17" SCOPE MOV #8.,SCBUF ;SET 8 LINE OF COMMANDS MOV #300,SCBUF+2 ;AT LOCATION 300 ON SCREEN MOV #340,DSFILE+4 ;POSITION LINE ABOVE COMMAND TEXT MOV #15.,DSARG ;DISPLAY 30 LINES OF TEXT 2$: MOV #NOP,G1 ;NOP THE CALL WHICH MOV #NOP,G1+2 ;GOT US HERE! MOV #DNOP,G2 ;REMOVE DISPLAY STOP .START ;RESTART DISPLAY .REMOV #TESTF ;REMOVE TEST FILE RTS PC ;THEN EXIT FOREVER ; TESTF: POINT 500 1350 LONGV 0 400 G2: 173000 ;DISPLAY STOP G3: DRET 0 ;END OF INITIALIZATION CODE .BLKW 1200 ;DISPLAY FILE DBUFE=. DRET 0 .ENDC ;<<<<<<<<<<<<<<<<<<<< .ENDC ;<<<<<<<<<<<<<<<<<<< .IFDF $CAPS11 ;>C>C>C>C>C>C>C>C>C>C START: MOV EDSTRT,SP IOT .BYTE 1,0 ;RESET + 0 IOT .BYTE 2,0 ;SET CONTROL/P RESTART + CPREST ; TO RETURN TO CMD. MODE MOV #ERRORT,@#30 CLR @#32 ;INIT ERROR TRAP VECTOR TSTB @#KBLRES ;IF KBL NOT RESIDENT, BNE ITSIN MOV @#HIFREE,R0 ; PUT LIMIT AT HIGHEST POSS. BR LIMIN ITSIN: MOV @#KBLADR,R0 TST -(R0) ;NOW HAVE HIGHEST FREE LOC LIMIN: MOV R0,BEND MOV R0,MBSTRT MOV R0,SBSTRT MOV EDTOP,R1 MOV R1,CBSTRT MOV R1,PBSTRT REENTR: MOV #NEGFLG,R0 REENT1: CLR (R0)+ ;LOOP TO INITIALIZE ALL FLAGS TO 0 CMP R0,#EQLENG BLOS REENT1 ;BRANCH IF NOT DONE MOV R1,PTR MOVB #1,RLIST MOVB #1,WLIST JMP ASTER ; CPREST: MOV EDSTRT,SP ;RESET STACK TSTB OTOFLG ;OUTPUT FILE OPEN? BEQ START ;NO: NEEDN'T CLOSE IT JSR PC,EFILE1 ;CLOSE OUTPUT FILE BR START ;START FROM SCRATCH .ENDC ;<<<<<<<<<<<<<<<<<<<< ; .EVEN EDEND=. ;TOP OF EDITOR .END START ; RT-11 MACRO ASSEMBLER VM02-11 ; ; DEC-11-ORMAA-E ; ; JUNE 1974 ; ; BOB BOWERING ; ERIC PETERS ; RICH BILLIG ; ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; .SBTTL RT-11 MACRO PARAMETER FILE RT11= 0 XBAW= 0 XEDPIC= 0 .TITLE MPARAM V02-12 3-NOV-75 .NLIST ; ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; ; ;JD CHANGED VERSION # .LIST .SBTTL COMMON PARAMETER FILE .IDENT /V0212/ .MACRO GVNUM ;GEN VERSION NUMBER .ASCII /02-12 / .ENDM .ENABL AMA ;ABSOLUTE MODE ADDRESSING .NLIST BEX .IIF NDF MCEXEC, .NLIST R0= %0 R1= %1 R2= %2 R3= %3 R4= %4 R5= %5 SP= %6 PC= %7 .SBTTL ASSEMBLY OPTIONS ;THE FOLLOWING MACRO CAUSES ASSEMBLY OPTIONS TO BE ;PRINTED ON THE LOADER MAP AND ANY IMPLICATIONS ;(SECOND ARGUMENT) TO BE DEFINED. OPTIONS ARE ;SELECTED BY EQUATING THEM TO ZERO. .MACRO LDRMAP MNE,IMPLIES .IF DF MNE .LIST ; .GLOBL MNE .NLIST .IRP X, X= 0 ;INVOKE IMPLICATIONS .ENDM .ENDC .ENDM LDRMAP ;THE FOLLOWING GROUP ENABLES FUNCTIONS LDRMAP PAL11R, LDRMAP PAL11R, LDRMAP PAL11R, LDRMAP RT11 LDRMAP RSX11D, ;RSX11D "FEATURES" LDRMAP DEBUG ;DEBUG VERSION LDRMAP DOSV4, ;DOS V4 COMPATIBLE LDRMAP PDPV45 ;PDP-11/45 INSTRUCTIONS LDRMAP TRAPS ;ENABLE TRAPS FOR CALLS LDRMAP OVLAY ;ENABLE OVERLAYS LDRMAP DBLBUF ;TRAN'D INPUT LDRMAP YPHASE ;.PHASE/.DEPHAS LDRMAP FIXSTK ;FIXED STACK LOCATION ;THE FOLLOWING GROUP DISABLES FUNCTIONS .IIF DF X40&X45, XFLTG= 0 LDRMAP XOVLAY ;SUPPRESS OVERLAYS LDRMAP XBAW ;NO BELLS AND WHISTLES LDRMAP XSWIT,XCREF ;NO SWITCHES LDRMAP XREL,XEDPIC ;ABS OUTPUT ONLY LDRMAP XMACRO,XSML ;ALL GENERATED CODE (MACRO, REPT, ETC.) LDRMAP XSML ;SYSTEM MACROS LDRMAP X40 ;PDP-11/40 FEATURES LDRMAP X45 ;PDP-11/45 FEATURES LDRMAP XFLTG,XEDFPT ;FLOATING POINT EVALUATION LDRMAP XEDABS ;ED.ABS LDRMAP XEDAMA ;ED.AMA LDRMAP XEDPIC ;ED.PIC LDRMAP XEDFPT ;ED.FPT LDRMAP XEDLSB ;ED.LSB LDRMAP XEDPNC ;ED.PNC LDRMAP XEDLC ;ED.LC LDRMAP XEDCDR ;CARD READER FORMAT LDRMAP XZERR ;"Z" ERRORS LDRMAP XLCTTM ;NO LPT LISTING FORMAT LDRMAP XLCSEQ ;SEQUENCE NUMBERS LDRMAP XCREF,XRUN ;CREF SUPPRESSION LDRMAP XRUN ;NO .RUN EMT USED ; LDRMAP XRESKB ;NO RESIDENT KB LDRMAP XTIME ;NO TIME & DATE ON HEADER LDRMAP DFLGTB ;????????? LDRMAP BRERR ;BRIEF SYSTEM ERRORS(RT11) .SBTTL VARIABLE PARAMETERS ;THE FOLLOWING PARAMETERS CAN BE MODIFIED ;AT ASSEMBLY TIME. .MACRO PARAM MNE, VALUE ;DEFINE DEFAULT PARAMETERS .IIF NDF MNE, MNE= VALUE .LIST MNE= MNE .NLIST .ENDM PARAM CPL, 80. ;CHARACTERS PER LISTING LINE PARAM LPP, 60. ;LINES PER PAGE .IF NDF PAL11R PARAM SRCLEN, 132. ;SOURCE STATEMENT LENGTH .IFF PARAM SRCLEN, 84. .ENDC LINLEN= SRCLEN OCTLEN= ^D<8*6> LSTLEN= OCTLEN+LINLEN+1 PARAM BPMB, 20 ;BYTES PER MACRO BLOCK PARAM OBJLEN, 42. ;OBJECT BLOCK LENGTH PARAM RLDLEN, 42. ;RLD BLOCK LENGTH PARAM CMILEN, 83. PARAM SMLLEN, 80. PARAM CRFLEN, 132. PARAM TTLLEN,32. ;TITLE LENGTH PARAM STLLEN,64. ;SUB-TITLE LENGTH PARAM SYSUIC, 000401 ;SYSTEM UIC [1,1] .MACRO PURGE NAME ;PURGE MACRO .MACRO NAME A,B,C,D,E,F,G,H,I,J .ERROR ;MACRO "NAME" PURGED .ENDM .ENDM PURGE .SBTTL GLOBALS ;GLOBALS DEFINED IN ASSEMBLER .GLOBL ASSEM .GLOBL MACP0, MACP1, ENDP1, MACP2, ENDP2 .IF NDF XSWIT .GLOBL ABSEXP, CHRPNT, GETR50, PASS, SYMBOL .GLOBL $EDABL, $NLIST, EXMFLG, ARGCNT, LC.TTM .GLOBL LCMASK, TTLBUF, TTLBRK, ERRBTS .ENDC .GLOBL PUTKB, PUTKBL, PUTLP .GLOBL DNC, MOVBYT, SAVREG, XMIT0 .GLOBL LINBUF, ERRCNT .IF NDF XBAW .GLOBL CTTBL .ENDC .IF NDF XEDABS .GLOBL ED.ABS, EDMASK .ENDC .IF NDF XCREF .GLOBL GSARG .ENDC .IF DF TRAPS .GLOBL TRPPRO .ENDC ;GLOBALS DEFINED IN MCEXEC .IF NDF XCREF .GLOBL CRFTST, CRFBUF, CRFCNT .ENDC .IF NDF XTIME .GLOBL DATTIM .ENDC .IF NDF XSML .GLOBL FINSML, INISML .ENDC .GLOBL GETPLI, HDRTTL .GLOBL IO.EOF, IO.TTY, IO.ERR .GLOBL SYTTOP, TSTSTK .GLOBL IOFTBL, CNTTBL, BUFTBL .IF DF FIXSTK .GLOBL TSTSYT .ENDC .SBTTL SECTOR INITIALIZATION ;SECTORS ARE ENTERED THROUGH THE MACRO ; "ENTSEC", SPECIFYING THE SECTOR NAME FOR THE ;ARGUMENT. THE MACRO "XITSEC" RETURNS TO ;THE DEFAULT SECTOR, "MAIN". THE NULL .CSECT IS ;NEVER USED. .MACRO ENTSEC NAME ;INIT A SECTION .CSECT NAME .ENDM .IF NDF OVLAY .MACRO XITSEC .CSECT .ENDM .IFF .MACRO XITSEC ;EXIT TO DEFAULT SECTION .CSECT MAIN .ENDM ;OVERLAYS ARE COLLECTED IN SECTORS OVR1 THROUGH ;OVRN, WHERE N (DECIMAL) IS THE NUMBER OF OVERLAYS. OVRLVL= 0 ;INIT OVERLAY LEVEL NUMOVR= 9. ;NUMBER OF OVERLAYS ALLOWED XXX= 0 ;LOOP COUNTER .RADIX 10 ;GENERATE DECIMAL EXTENSIONS .REPT NUMOVR XXX= XXX+1 ;BUMP COUNT .IRP N,<\XXX> ;FORCE BINARY TO ASCII ENTSEC OVR'N OVR'N'B: .ENDM .ENDR .RADIX 8 ;BACK TO OCTAL ENTSEC OVRSEP ;OVERLAY SEPARATOR OVRSEP: ENTSEC OVR1 .LIMIT ;OVERLAY TEST LOCATION GVNUM .BYTE 0 .EVEN .ENDC .IF DF OVLAY ENTSEC MAIN$ ;EXEC'S COPY ENTSEC MAIN ;DEFAULT SECTOR .ENDC ENTSEC DPURE ;D-SPACE, PURE ENTSEC DPURE$ ENTSEC MIXED$ ;MIXED PURE AND IMPURE TAB= 11 LF= 12 VT= 13 FF= 14 CR= 15 SPACE= 40 .SBTTL SUBROUTINE CALL DEFINITIONS ;THE MACRO "CALL" IS THE EQUIVALENT OF "JSR PC," AND ;IS USED FOR SIMPLICITY. THE MACRO "RETURN" IS THE ;EQUIVALENT OF "RTS PC". .MACRO CALL ADDRESS JSR PC,ADDRESS .ENDM .MACRO RETURN RTS PC .ENDM ;THE MACRO "GENCAL" DEFINES A MACRO WHICH CALLS A ;SUBROUTINE OF THE SAME NAME. IF "TRAPS" ARE ENABLED, ;GENCAL CAUSES A TRAP. .IF NDF TRAPS .MACRO GENCAL NAME ;CAN BE CHANGED TO OPDEFS OR TRAPS .MACRO NAME JSR PC,NAME .ENDM .ENDM .IFF .MACRO GENCAL NAME ENTSEC TRPSEC .IRP OFFSET, <\.-TRPBAS> ;GENERATE NUMERIC TRP'OFFSET= TRAP+OFFSET .WORD NAME .MACRO NAME .WORD TRP'OFFSET .ENDM .ENDM XITSEC .ENDM ENTSEC TRPSEC TRPBAS: ;TRAP VECTOR TABLE XITSEC .ENDC .IF DF OVLAY GENCAL CALOVR .MACRO SETOVR N .IF NE OVRLVL .ERROR OVRLVL ; NOT = 0 .ENDC .IF NDF XOVR'N OVRLVL= 1 OVRBAS= OVR'N'B .CSECT OVR'N OVRTMP= . .MACRO XITSEC .CSECT OVR'N .ENDM XITSEC .ENABL PIC .IFF OVRLVL= -1 .ENDC .ENDM .MACRO ENTOVR N SETOVR N .IF GT OVRLVL .CSECT MAIN CALOVR .WORD OVRTMP .CSECT OVR'N .ENDC .ENDM .MACRO XITOVR INLINE .IF EQ OVRLVL .ERROR OVRLVL ; NOT = 1 .ENDC .IF NB .CSECT MAIN OV.TMP= . XITSEC JMP OV.TMP .ENDC OVRLVL= 0 .MACRO XITSEC .CSECT MAIN .ENDM XITSEC .DSABL PIC .ENDM .MACRO JMPOVR ADRPNT ;JUMP TO POSSIBLE OVERLAY .NTYPE T.VAL, ADRPNT .IF NE T.VAL-26 ;(SP)+ MOV ADRPNT,-(SP) .ENDC JMP CALOVF .ENDM .IFF ;DEFAULTS FOR NON-OVERLAY .MACRO SETOVR NAME .ENDM .MACRO ENTOVR NAME .ENDM .MACRO XITOVR INLINE .ENDM .MACRO JMPOVR ADRPNT JMP @ADRPNT .ENDM .ENDC .SBTTL MISCELLANEOUS MACRO DEFINITIONS .MACRO PUTKB ADDR ;LIST TO KB MOV ADDR,R0 CALL PUTKB .ENDM .MACRO PUTLP ADDR ;LIST TO LP MOV ADDR,R0 CALL PUTLP .ENDM .MACRO PUTKBL ADDR ;LIST TO KB AND LP MOV ADDR,R0 CALL PUTKBL .ENDM .MACRO PUTLIN ADDR ;USE LISTING FLAGS .IF DIF MOV ADDR,R0 .ENDC CALL PUTLIN .ENDM .MACRO XMIT WRDCNT ;MOVE SMALL # OF WORDS CALL XMIT0- .ENDM XMIT ;THE MACRO "GENSWT" IS USED TO SPECIFY A COMMAND ;STRING SWITCH (1ST ARGUMENT) AND THE ADDRESS OF ;THE ROUTINE TO BE CALLED WHEN ENCOUNTERED (2ND ARG). ENTSEC SWTSE$ ;SWITCH TABLE SWTBAS: ENTSEC SWTSEC .MACRO GENSWT MNE,ADDR,?LABEL .IF NDF MCEXEC ENTSEC SWTSEC .IFF ENTSEC SWTSE$ .ENDC LABEL: .ASCIZ /MNE/ . = LABEL+2 ;TRIM TO ONE WORD .WORD ADDR XITSEC .ENDM XITSEC .IIF NDF MCEXEC, .LIST ; RCIOCH.MAC V02-11 .NLIST ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; .LIST .SBTTL MCIOCH - I/O CHANNEL ASSIGNMENTS .MACRO GENCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE SETCHN SRC, SRC, , 3, 0 SETCHN LST, LST, , 1, 0 SETCHN BIN, OBJ, , 0, 1 .IF NDF XREL SETCHN REL, RLD, , 0, 1 .ENDC .IF NDF XSML SETCHN SML, SML, SML, 16, 0 .ENDC .IF NDF XCREF SETCHN CRF, CRF, , 2, 0 .ENDC .IF NDF RT11 SETCHN CMI, CMI, CMI, 14, 0 SETCHN CMO, LST, CMO, 15, 0 .ENDC .ENDM TMPCNT= 0 .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST ZCHAN'CHN= TMPCNT .NLIST TMPCNT= TMPCNT+2 .ENDM GENCHN MAXCHN= TMPCNT ;JUST TO PRESERVE THE COUNT .IRP X, .GLOBL $'X .MACRO $'X CHAN MOV #CHAN'CHN,R0 CALL $'X .ENDM $'X .ENDM .TITLE RTEXEC V02-11 4-SEP-75 .NLIST ; COPYRIGHT (C) 1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; .LIST .GLOBL START,CONT,FIN MCEXEC=0 .MCALL .SETTOP,.WAIT,.CLOSE,.SRESET,.LOOKUP,.CSIGEN .MCALL .PRINT,.DATE,.LOCK,.UNLOCK,.RCTRLO,.CSISPC,.ENTER .MCALL .TTYOUT,.TTYIN,.FETCH .MCALL ..V1.. ..V1.. USRLOC=46 HIGHAD=50 EMTERR=52 MONLOW=54 CONFIG=300 CLK50=40 JSW=44 RENTER=20000 SPAREA=500 TTYBUF=SPAREA+<39.*2> PARAM STKFDG,60. ;STACK OVERFLOW FUDGE FACTOR ENTSEC IMPUR$ IMPUR$: .MACRO XITSEC ;OVER-RIDE FOR EXEC .CSECT MAIN$ .ENDM XITSEC XITSEC .IF NDF BRERR ;BRIEF ERRORS? .MACRO SERROR NUMBER,MESSAGE JSR R0,SERROR .ASCIZ /?'MESSAGE'?/ .EVEN .ENDM SERROR .IFF .MACRO SERROR NUMBER,MESSAGE JSR R0,SERROR .ASCIZ /?'NUMBER'?/ .EVEN .ENDM SERROR .ENDC .SBTTL PROGRAM START BR ERRB ;REENTRY POINT START: .IF DF TRAPS MOV #TRPPRO,@#34 ;SET UP TRAP VECTOR CLR @#36 .ENDC ; SET UP USR TO LOAD OVER PURE CODE >>>>>>>>>>>>>>>>>>>>>>>>>>> MOV #ASSEM,@#USRLOC BIS #RENTER,@#JSW ;MARK JOB REENTERABLE MOV @#MONLOW,R1 ;LOWER LIMIT OF RESIDENT MONITOR SUB #2,R1 .SETTOP R1 ;EXCISE THE USR MOV @#HIGHAD,STKSAV ;INITIALIZATION FOR STACK .IF DF FIXSTK MOV #SYMBUE,SYTTOP .ENDC CONT: MOV #IMPUR$,R1 ;CLEAR IMPURE AREA 1$: CLR (R1)+ CMP R1,#IMPURT BLO 1$ CALL ASSEM ;INITIALIZE SYMBOL ROLLS MOV STKSAV,SP ;AND INIT THE STACK MOV #CTLTBL,R0 2$: MOV (R0)+,R1 ;GET ADDR OF NEXT ROUTINE TO EXEC MOV R0,-(SP) ;SAVE POINTER CALL (R1) ;EXEC NEXT ROUTINE MOV (SP)+,R0 ;RETRIEVE POINTER BR 2$ ENTSEC DPURE$ CTLTBL: ;TABLE TO EXEC ASSEMBLER .WORD INIOF, MACP0 .WORD INIP1, MACP1 .WORD FINP1, ENDP1 .WORD INIP2, MACP2 .WORD FINP2, ENDP2 .WORD SETDN ;GO TO RESTART POINT XITSEC ERRB: JMP ERR .SBTTL INIT OUTPUT FILES INIOF: DEC FRECOR ;INITIALIZE FREE CORE COUNT MOV #TTYBUF,R2 ;POINT TO INPUT LINE BUFFER .TTYOUT #'* ;PRINT PROMPT 4$: .TTYIN ;READ COMMAND STRING MOVB R0,(R2)+ ;STORE IN BUFFER CMPB #LF,R0 ;END-OF-LINE? BNE 4$ ;NOPE - CONTINUE CLRB -(R2) ;MAKE ASCIZ FOR CSI CLRB -(R2) .LOCK ;KEEP USR IN CORE MOV SP,R3 ;SAVE STACK POINTER .CSISPC #SPAREA,#DEFEXT,#TTYBUF MOV R3,SP ;RESET STACK TO DISCARD SWITCHES MOV PRGLIM+2,R0 ;UPPER LIMIT OF ASSEMBLED CODE .CSIGEN R0,#DEFEXT,#TTYBUF ;GENERAL MODE CSI CALL MOV R0,R1 ;BASE OF I/O BUFFERS ROR -(SP) ;SAVE CARRY MOVB @#EMTERR,@SP ;SAVE ERROR SPECS .UNLOCK ;RELEASE USR AGAIN MOV (SP)+,R0 ;GET ERROR FLAGS BPL 5$ ;IF NO ERROR IN COMMAND MOVB R0,R0 ;ELSE GET CODE ASL R0 ;SELECT CORRECT MSG MOV CSIERR(R0),R0 ;POINT TO MSG JMP SERROR ;AND PRINT IT 5$: MOVB #CR,(R2)+ ;FIX END OF TTYBUF AGAIN MOVB #LF,(R2)+ CLRB (R2)+ .WAIT 0 ;CHECK BINARY OUTPUT CHAN BCS 1$ ;NOT THERE BIS #IO.NNU,IOFTBL+BINCHN MOV R1,PTRTBL+ MOV R1,PTRTBL+ ADD #512.,R1 ;POINT TO END OF BUFFER MOV R1,BLKTBL+ ;SAVE BUF ADDR MOV R1,BLKTBL+ 1$: .WAIT 1 ;LISTING OUTPUT? BCS 3$ ;NO BIS #IO.NNU,IOFTBL+LSTCHN MOV R1,PTRTBL+ ADD #512.,R1 ;POINT TO END OF BUFFER MOV R1,BLKTBL+ 3$: MOV R1,STKLIM ;SET LOWER STACK BOUNDARY MOV (SP)+,R0 ;GET # OF SWITCHES .IF NDF XSWIT BEQ ENDSWT ;NO SWITCHES - JUMP MOV #-1,EXMFLG ;INDICATE SWITCH PROCESSING SWNEXT: MOV (SP)+,R1 ;GET NEXT SWITCH MOV #SWTBL,R2 ;ADDR OF SWITCH TABLE 10$: CMPB (R2)+,R1 ;IS THIS THE ONE? BEQ 12$ ;YUP - GO CALL ROUTINE INC R2 ;ELSE POINT TO NEXT TABLE ENTRY CMP #SWTEND,R2 ;TABLE EXHAUSTED? BNE 10$ ;NO - GO BACK BR SWTERR ;ELSE ERROR - BAD SWITCH 12$: MOVB @R2,R2 ;GET ROUTINE INDEX TST R1 ;WAS VALUE SUPPLIED? BMI 13$ ;YES - SKIP NEXT CLR -(SP) ;ELSE SUPPLY DEFAULT 13$: CLR R3 ;CLEAN REGS 3 & 5 CLR R5 JMP .+132.(R2) ;BRANCH TO APPROPRIATE ROUTINE SWTDON: DEC R0 ;# OF SWITCHES - 1 BNE SWNEXT ;GO BACK IF ANY LEFT .IFF BNE SWTERR ;NO SWITCHES ARE LEGAL .ENDC ;NDF XSWIT ENDSWT: MOV STKLIM,R1 ;GET PRELIMINARY HIGH LIMIT .IF NDF XCREF TST CRFFLG ;CREF REQUESTED? BEQ 1$ ;NOPE .WAIT 2 ;WAS A CREF FILE SPECIFIED? BCC 2$ ;YES - DON'T BOTHER WITH HANDLER .FETCH R1,#CRFSPC ;GET HANDLER FOR DK LOADED MOV R0,R1 ;AND POINT ABOVE IT 2$: BIS #IO.NNU,IOFTBL+CRFCHN ;INDICATE CREF FILE PRESENT MOV R1,PTRTBL+ ADD #512.,R1 ;ALLOCATE CREF BUFFER MOV R1,BLKTBL+ .ENDC 1$: ADD #512.,R1 ;ALLOCATE SOURCE FILE BUFFER MOV R1,BLKTBL+ ADD #STKFDG,R1 ;ALLOW SOME BREATHING ROOM MOV R1,STKLIM ;AND SET STACK LIMIT JMP DATE ;END OF SWITCHES - JUMP AROUND HANDLRS .SBTTL SWITCH HANDLERS SWTERR: SERROR BSW, .IF NDF XSWIT ; LIST/NOLIST SWITCH ROUTINES SWRN: COM R3 ;R3 = -1 FOR NLIST SWRL: ASL R3 ;R3 = 1 FOR LIST INC R3 MOV (SP)+,SYMBOL ;INSTALL SWITCH VALUE IN SYMBOL CLR SYMBOL+2 MOV #1,ARGCNT MOV R0,-(SP) ;SAVE # OF SWITCHES LEFT CALL $NLIST ;LET .LIST/.NLIST HANDLER DO THE WORK BR SWTCOM ; ENABL/DSABL SWITCH ROUTINES SWRD: COM R3 ;R3 = -1 FOR DSABL SWRE: MOV (SP)+,SYMBOL ;R3 = 0 FOR ENABL CLR SYMBOL+2 MOV R0,-(SP) ;SAVE # OF SWITCHES REMAINING CALL $EDABL ;CALL .ENABL/.DSABL PROCESSOR SWTCOM: MOV (SP)+,R0 ;RESTORE # OF SWITCHES TST ERRBTS ;ERROR IN VALUE? BNE SWTERR ;YES BR SWTDON ;ELSE WE'RE DONE .IF NDF XCREF ; CREF SWITCH ROUTINE SWRC: MOV #CRFTAB,R2 ;GET ADRS OF VALUE TABLE 1$: CMP @SP,(R2)+ ;IS THIS THE ONE? BEQ 2$ ;YES TST (R2)+ ;ELSE SKIP FLAG BITS TST @R2 ;END OF TABLE? BNE 1$ ;NOPE BR SWTERR ;ELSE ERROR 2$: BIS @R2,CRFFLG ;REMEMBER SECTIONS REQUESTED TST (SP)+ ;DISCARD SWITCH VALUE BR SWTDON ;AND LEAVE ENTSEC IMPUR$ CRFFLG: .WORD 0 CRFTST: .WORD 0 CRFCNT: .WORD 0 ;# OF REFERENCES MADE IN PASS 1 XITSEC .ENDC .ENDC .SBTTL END-OF-PASS ROUTINES INIP1: ;INITIALIZE PASS 1 .WAIT 3 ;CHECK 1ST INPUT FILE BCC INITI ;OKAY SERROR NIF, INIP2: ;INITIALIZE PASS 2 .IF NDF XCREF MOV CRFFLG,CRFTST ;ALLOW CREF OUTPUT ON PASS 2 BEQ 1$ ;NO CREF REQUESTED .WAIT 2 ;DID HE SPECIFY A FILE ALREADY? BCC 1$ ;YES - NOTHING TO DO NOW .ENTER 2,#CRFSPC,#0 ;ELSE ENTER THE CREF FILE .ENDC 1$: CLR RECNUM+SRCCHN ;INPUT RECORD # INITI: MOV #3,CHAN+SRCCHN ;SET RT11 INPUT CHAN ;AND INPUT BUFFER POINTER MOV BLKTBL+,R0 MOVB #FF,-(R0) ;START PASS WITH A FORM FEED MOV R0,PTRTBL+ FINP1: ;FINISH PASS 1 FINP2: RETURN ;FINISH PASS 2 .SBTTL SWITCH AND DATE DATA AREAS ENTSEC DPURE$ .IF NDF XSWIT .MACRO SWTGEN SW.NAM .ASCII /SW.NAM/ .BYTE SWR'SW.NAM-SWTDON-128. .ENDM .MACRO GSWARG SWARG,SWVAL .RAD50 /SWARG/ .WORD SWVAL .ENDM .IF NDF XCREF CRFS=000002 ; SYMBOL CREF DESIRED CRFR=000004 ; REGISTER CREF DESIRED CRFM=000010 ; MACRO CREF DESIRED CRFP=000020 ; PST CREF DESIRED CRFC=000040 ; CSECT CREF DESIRED CRFE=000100 ; ERROR CREF DESIRED CRFTAB: GSWARG < >,CRFS+CRFM+CRFE GSWARG S,CRFS GSWARG R,CRFR GSWARG M,CRFM GSWARG P,CRFP GSWARG C,CRFC GSWARG E,CRFE .WORD 0 ; END OF TABLE FLAG CRFPNT: .WORD 0 .ENDC SWTBL: .IF NDF XCREF SWTGEN C .ENDC SWTGEN D SWTGEN E SWTGEN L SWTGEN N SWTEND = . .ENDC PRGLIM: .LIMIT DEFEXT: .IF NDF XMACRO .RAD50 /MAC/ .IFF .RAD50 /PAL/ .ENDC .RAD50 /OBJ/ .RAD50 /LST/ .IF NDF XCREF .RAD50 /CRF/ .IFF .WORD 0 .ENDC .IF NDF XCREF CRFSPC: .RAD50 /DK / .RAD50 /CREF / .RAD50 /TMP/ .ENDC .IF NDF XTIME MONTBL: .ASCIZ /JAN/ ;TABLE OF MONTH NAMES .ASCIZ /FEB/ .ASCIZ /MAR/ .ASCIZ /APR/ .ASCIZ /MAY/ .ASCIZ /JUN/ .ASCIZ /JUL/ .ASCIZ /AUG/ .ASCIZ /SEP/ .ASCIZ /OCT/ .ASCIZ /NOV/ .ASCIZ /DEC/ TIMWRD: .BYTE 0,21 ;V2 TIME PARAMETER BLOCK .WORD TIME ;ADRS OF TIME AREA TIME: .BLKW 2 ;TIME-OF-DAY AREA .ENDC CSIERR: .WORD ILLCMD ;CSI ERROR CODES .WORD ILLDEV .WORD 0 .WORD DEVFUL .WORD FILNF ILLCMD: .ASCIZ /?ILL CMD?/ ILLDEV: .ASCIZ /?ILL DEV?/ DEVFUL: .ASCIZ /?DEV FUL?/ FILNF: .ASCIZ /?FIL NOT FND?/ .EVEN XITSEC .SBTTL INIT OUTPUT FILES (CONTINUED) DATE: .IF NDF XTIME MOV #TIMWRD,R0 ;ADRS OF TIME PARAMETER BLOCK EMT 375 ;THIS REALLY SHOULD BE A .GTIM .DATE ;GET CODED DATE INTO R0 MOV #DATTIM+1,R2 ;CHAR PTR MOV R0,R1 ;DATE WORD BEQ 5$ ;NO DATE, SO SKIP IT MOV R1,-(SP) ROL R1 ROL R1 ROL R1 SWAB R1 BIC #177740,R1 CALL DNC ;DAY MOVB #'-,(R2)+ MOV @SP,R1 SWAB R1 BIC #177703,R1 ADD #MONTBL-4,R1 ;POINT TO MONTH CALL MOVBYT MOVB #'-,(R2)+ MOVB (SP)+,R1 BIC #177740,R1 ADD #72.,R1 CALL DNC ;YEAR 5$: MOV #TIME,R3 ;PICK UP TIME OF DAY MOV (R3)+,R0 ;HIGH ORDER MOV @R3,R1 ;LOW ORDER BNE 6$ ;THERE DEFINITELY IS TIME TST -(R3) ;ELSE CHECK BEQ 9$ ;OOPS - NO TIME 6$: MOV @#MONLOW,R4 ;CHECK FOR 50-CYCLE CLOCK MOV #60.,R3 ;TENTATIVELY 60-CYCLE BIT #CLK50,CONFIG(R4) ;50-CYCLE? BEQ 7$ ;NOPE MOV #50.,R3 ;ELSE CHANGE DIVISOR 7$: CALL DIV60 ;GET RID OF TICKS CALL DIV60 ;GET SECONDS IN R5 CLR -(SP) ;STOPPER FOR DIGIT DUMPER MOV R5,-(SP) ;AND SAVE THEM CALL DIV60 ;NOW GET MINUTES IN R5 ;AND HOURS IN R1 MOV R5,-(SP) ;AND SAVE MINUTES MOV #24.,R3 ;ASSURE MIDNIGHT ROLLOVER CALL DIV60 ;GET HOURS IN R5 INC R2 ;LEAVE A BLANK AFTER DATE 8$: MOVB R5,(R2)+ ;STORE FIRST DIGIT SWAB R5 ;GET OTHER ONE MOVB R5,(R2)+ ;STORE SECOND ONE MOVB #':,(R2)+ ;PUT OUT DELIMITER MOV (SP)+,R5 ;GET NEXT SET OF DIGITS BNE 8$ ;THERE ARE STILL SOME LEFT DEC R2 ;SET TO CLOBBER LAST ":" 9$: CLRB (R2)+ ;MAKE LINE ASCIZ RETURN ; DIVIDE R0-R1 BY R3, LEAVING REMAINDER IN R5. ; DESTROYS R4,R5. DIV60: CLR R5 ;INITIALIZE REMAINDER MOV #32.,R4 ;AND COUNT OF BITS 1$: ASL R1 ;SHIFT LOW ORDER ROL R0 ;SHIFT HIGH ORDER ROL R5 ;AND REMAINDER CMP R5,R3 BLO 2$ SUB R3,R5 INC R1 2$: DEC R4 BNE 1$ 3$: ADD #366,R5 ;APPLY MAGIC NUMBER TRANSFORMATION TSTB R5 ;TO GET REMAINDER IN ASCII BPL 3$ ADD #"00-366,R5 SWAB R5 MOV #60.,R3 ;ASSURE CORRECT DIVISOR .ENDC RETURN .SBTTL FINISH ASSEMBLY AND RESTART SETDN: MOV #FINMSG,R1 MOV #LINBUF,R2 CALL MOVBYT ;POSITION MESSAGE MOV ERRCNT,R1 CALL DNC ;DECIMAL NUMBER CONVERTER MOV #FINMS1,R1 CALL MOVBYT MOV FRECOR,R1 .IF NDF FIXSTK SUB STKLIM,R1 ;CALC FREE CORE .IFF SUB #SYMBUF+20.,R1 ;CALC FREE CORE .ENDC ROR R1 ;IN WORDS CALL DNC MOV #FINMS2,R1 CALL MOVBYT PUTLP #LINBUF ;PRINT ON LISTING PUTLP #TTYBUF ;ALSO PRINT COMMAND STRING FIN: $FLUSH LST ;DUMP LAST BUFFERS $FLUSH BIN .RCTRLO .PRINT #LINBUF ;PRINT STATISTICS ON TTY .IF NDF XCREF $FLUSH CRF TST CRFFLG ;ANY CREF DESIRED? BEQ FINCL ;NOPE MOV #CHNSPC,R2 ;ELSE POINT TO CHAIN INFO MOV (R2)+,R1 ;R1 = 500 (.CHAIN AREA) MOV (R2)+,(R1)+ ;MOVE IN CREF NAME MOV (R2)+,(R1)+ MOV (R2)+,(R1)+ MOV (R2)+,(R1)+ MOV (R2)+,(R1)+ ;OUTPUT (LST) CHANNEL # TST (R1)+ ;OUTPUT DEVICE (SET BY CSISPC) BEQ FINCL ;NO CREF IF NO LISTING DEVICE MOV RECNUM+LSTCHN,(R1)+ ;OUTPUT HIGHEST BLOCK WRITTEN MOV (R2)+,(R1)+ ;INPUT (CRF) CHANNEL # MOV (R2)+,(R1)+ ;INPUT DEVICE MOV @#<500+<2*10.>>,R0 ;GET DEVICE, IF SPECIFIED BEQ 3$ ;NOPE - JUST USE DEFAULT MOV R0,-2(R1) ;ELSE PUT IN INTERFACE 3$: MOV RECNUM+CRFCHN,(R1)+ ;INPUT HIGHEST BLOCK WRITTEN CLR (R1)+ ;LISTING WIDTH FLAG BIT #LC.TTM,LCMASK ;IN .NLIST TTM MODE? BEQ 1$ ;NOPE COM -2(R1) ;ELSE NOTE 1$: MOV (R2)+,(R1)+ ;MOVE IN NAME OF RETURN CHAIN MOV (R2)+,(R1)+ MOV (R2)+,(R1)+ MOV (R2)+,(R1)+ MOV @R2,R2 ;POINT TO LAST TITLE LINE 2$: MOVB (R2)+,(R1)+ ;COPY INTO CHAIN AREA CMP R2,TTLBRK ;END OF TITLE? BLO 2$ ;NOPE - KEEP COPYING CLRB (R1)+ ;ASSURE ASCIZ $CLOUT BIN ;ASSURE BINARY CLOSED MOV #10*400,R0 ;AND CHAIN TO CREF EMT 374 BR ERR ;CAN'T HAPPEN (EXCEPT IN DISASTERS) .ENDC ;NDF XCREF FINCL: .LOCK ;KEEP USR IN CORE $CLOUT BIN ;CLOSE BINARY $CLOUT LST ;AND LISTING .UNLOCK ;RELEASE USR ERR: .SRESET .RCTRLO JMP CONT SERROR: .PRINT ;PRINT ERROR MESSAGE BR ERR .SBTTL MEMORY MANAGEMENT TSTSTK: ;TEST IF STACK OUT OF BOUNDS CMP SP,STKLIM BLO CORERR .IF NDF FIXSTK CMP SP,FRECOR ;NEW RECORD FOR STACK BHIS 1$ ;NO MOV SP,FRECOR ;YES, RECORD IT .IFTF 1$: RETURN CORERR: SERROR CORE, .IFF TSTSYT: ;TEST SYMBOL TABLE CMP ROLBAS,#SYMBUF+20. BLO CORERR CMP ROLBAS,FRECOR ;NEW RECORD FOR TABLE? BHIS 1$ ;NO MOV ROLBAS,FRECOR ;YES, RECORD IT 1$: RETURN ENTSEC ROLBAS ROLBAS: .IFTF ENTSEC MIXED$ STKSAV: .BLKW STKLIM: .BLKW .IFT SYTTOP=STKSAV .IFF SYTTOP: .BLKW ENTSEC SYMBUF SYMBUF: .BLKW 4000. ;FIXED SYMBOL TABLE SYMBUE: .ENDC ENTSEC IMPUR$ FRECOR: .BLKW XITSEC .SBTTL GET PHYSICAL SOURCE LINE WINST=EMT+240 GETPLI: $READW SRC CLR R0 BIT #IO.EOF,IOFTBL+SRCCHN ;END OF FILE? BEQ 2$ ;NO MOV CHAN+SRCCHN,R0 ;GET CURRENT INPUT CHAN INC R0 ;MOVE TO NEXT CHAN CMP R0,#8. ;LAST CHAN? BHI 1$ ;YES, FLAG END OF INPUT CLR RECNUM+SRCCHN ;RESET RECORD (BLK) NUMBER MOV BLKTBL+,PTRTBL+ MOV R0,CHAN+SRCCHN BIS #WINST,R0 ;CREATE A WAIT CALL FOR NEXT CHAN MOV R0,@PC ;AND STORE IN NEXT LOCATION .WAIT 0 BCS 1$ ;BRANCH IF NO MORE INPUT MOV #-1,R0 ;FLAG END OF FILE 2$: RETURN 1$: MOV #1,R0 ;FLAG END OF INPUT RETURN .SBTTL SYSTEM MACRO HANDLERS .IF NDF XSML .ENABL LSB INISML: TST SMLSW ;NEW CALL? BNE FINSML ;NO, EXIT INC SMLSW ;SET SWITCH CLR RECNUM+SMLCHN ;RESET RECORD # .WAIT 16 ;CHANNEL ALREADY OPEN? BCC 1$ ;YES .LOOKUP 16,#SMDBLK ;LOOK UP SYSTEM MACRO FILE BCS 2$ ;SOMETHING WRONG 1$: MOV #BLKTBL+,R0 MOV @R0,-(R0) ;SET BUF PTR TO EMPTY MOV SP,R0 ;SIGNAL GOOD (NON-ZERO) RETURN RETURN FINSML: 2$: CLR R0 ;SIGNAL DONE CLR SMLSW ;CLEAR SWITCH RETURN .DSABL LSB ENTSEC DPURE$ SMDBLK: .RAD50 /SY/ ;DEVBLK FOR SYSTEM MACRO FILE .RAD50 /SYSMAC/ .RAD50 /SML/ ENTSEC MIXED$ .BLKW 256. ;BUFFER FOR SYSTEM MACROS SMLBLK: ENTSEC IMPUR$ SMLSW: .BLKW XITSEC .ENDC .SBTTL WRITE ROUTINES $WRITW: $WRITE: CALL SAVREG BIC #IO.EOF!IO.ERR,IOFTBL(R0) ;CLEAR FLAGS MOV CNTTBL(R0),R4 MOV (R4)+,R1 ;ACTUAL BYTE COUNT MOV (R4)+,R2 ;LOGICAL BUFFER POINTER MOV (R4)+,R3 ;PHYSICAL BUFFER POINTER ; R4 NOW POINTS TO PHYSICAL BUFFER END POINTER TSTB IOLTBL+1(R0) ;BINARY MODE? BNE 3$ ;YES 1$: MOVB (R2)+,(R3)+ ;MOVE LINE CMP R3,@R4 ;END OF PHYSICAL BUFFER BLO 2$ ;NO CALL POUT ;YES; PERFORM WRITE BCS WRTERR ;EXIT IF ERRORS 2$: DEC R1 BNE 1$ ;LOOP UNTIL LINE FINISHED MOV R3,-(R4) ;UPDATE BUFFER POINTER RETURN ; FORMATTED BINARY WRITE 3$: MOV #BINCHN,R0 ADD #4,R1 ;INCLUDE PROTOCOL BYTES IN COUNT MOV R1,-(R2) ;MOVE BYTE COUNT TO BEFORE BUFFER TST -(R2) ;MAKE R2 POINT TO FLAG WORD(1) MOV R5,-(SP) CLR -(SP) CLR R5 ;INIT CHECKSUM 4$: MOVB (R2)+,@SP ADD @SP,R5 ;ADD CHAR TO CKSUM MOVB @SP,(R3)+ ;AND MOVE CHAR TO OUTPUT 5$: CMP R3,@R4 ;OUTPUT BUFFER OVERFLOW? BLO 6$ ;NO CALL POUT ;YES, DUMP BUFFER BCS WRTERR ;EXIT IF ERRORS 6$: DEC R1 BGT 4$ BEQ 7$ ;GO TO STORE CKSUM MOV R3,PTRTBL+ ;UPDATE BUF PTR MOV R3,PTRTBL+ ;FOR BOTH BINARY CHNS TST (SP)+ MOV (SP)+,R5 RETURN 7$: NEG R5 MOVB R5,(R3)+ ;STORE CKSUM BR 5$ WRTERR: BIT #IO.ERR,IOFTBL(R0) ;I/O ERROR? BNE IOERR ;YES - REPORT SERROR ODF, IOERR: MOV CHAN(R0),R0 ;GET CHANNEL OF ERROR ADD #'0,R0 ;MAKE ASCII MOVB R0,IOERRN ;AND STORE IN MESSAGE JSR R0,SERROR ;GO PRINT MESSAGE .ASCII "?I/O ERROR ON CHANNEL " IOERRN: .ASCIZ " ?" .EVEN .SBTTL READ ROUTINE $READW: $READ: CALL SAVREG BIC #IO.EOF!IO.ERR,IOFTBL(R0) ;CLEAR FLAGS CLR R1 ;BYTE COUNT MOV CNTTBL(R0),R4 TST (R4)+ MOV (R4)+,R2 ;LINE BUFFER POINTER MOV (R4)+,R3 ;PHYSICAL BUFFER POINTER ; R4 NOW POINTS TO PHYSICAL BUFFER END POINTER MOV R5,-(SP) 1$: CMP R3,@R4 ;INPUT BUFFER EMPTY? BLO 2$ ;NO CALL PIN ;YES, FILL IT BCC 2$ ;BRANCH IF NO ERRORS BIT #IO.EOF,IOFTBL(R0) ;END-OF-FILE? BNE 4$ ;YES - HANDLE BR IOERR ;ELSE FATAL - REPORT 2$: MOVB (R3)+,R5 ;GET NEXT BYTE BIC #177600,R5 ;STRIP ASCII TO 7 BITS INC R1 ;ASSUME GOOD CHAR MOVB R5,(R2)+ ;STUFF IT INTO LINE CMPB R5,#SPACE ;GOOD CHAR? BLO 3$ ;BRANCH IF SPECIAL CHAR CMPB R5,#173 ;IGNORE CHAR? BHIS 6$ CMPB R1,IOLTBL(R0) ;LINE TOO LONG? BLO 1$ ;OKAY BIS #IO.ERR,IOFTBL(R0) ;FLAG ERROR MOVB #LF,-(R2) ;INSERT A LINE TERMINATOR BR 4$ 3$: CMPB R5,#LF ;LINE TERMINATOR? BNE 5$ ;TRY AGAIN 4$: MOV R1,@CNTTBL(R0) ;YES, END OF LINE MOV R3,-(R4) ;UPDATE PHYSICAL BUF PTR MOV (SP)+,R5 RETURN 5$: CMPB R5,#CR ;LEAVE ALONE BEQ 1$ CMPB R5,#TAB ;LEAVE TABS BEQ 1$ CMPB R5,#FF ;ALTERNATE LINE TERMINATOR? BEQ 4$ ;YES 6$: DEC R1 ;NO, IGNORE ALL OTHER CHARS DEC R2 ;REMOVE FROM BUFFER BR 1$ .SBTTL COMMON I/O ROUTINES POUT: MOV R1,-(SP) MOV #EMT+220,R1 ;PLACE WRITE EMT INTO R1 BR PIO PIN: MOV R1,-(SP) MOV #EMT+200,R1 ;PLACE READ EMT INTO R1 PIO: MOV R0,-(SP) CLR -(SP) ;BEGIN SETTING UP MONITOR CALL MOV #256.,-(SP) ;WORD COUNT MOV @R4,R3 ;GET BUFFER END POINTER SUB #512.,R3 ;NOW POINT TO BEGINNING MOV R3,-(SP) ADD CHAN(R0),R1 ;CREATE PROPER EMT MOV RECNUM(R0),R0 ;BLOCK NUMBER MOV R1,@PC ;STORE EMT IN NEXT LOCATION EMT 220 ;MODIFIED AT RUNTIME!!!!!!!! MOV (SP)+,R0 MOV (SP)+,R1 INC RECNUM(R0) BCC $WAIT ;NORMAL RETURN TSTB @#EMTERR ;ZERO IF EOF BEQ 2$ BIS #IO.ERR,IOFTBL(R0) ;FLAG BAD ERROR BR 3$ 2$: BIS #IO.EOF,IOFTBL(R0) ;FLAG END OF FILE 3$: SEC $WAIT: RETURN ; FLUSH OUTPUT BUFFERS $FLUSH: TST IOFTBL(R0) ;ANYTHING TO DO? BEQ $WAIT MOV CNTTBL(R0),R4 CMP (R4)+,(R4)+ MOV (R4)+,R3 ;BUFFER POINTER MOV @R4,R1 ;END OF BUFFER MOV R1,R2 SUB #512.,R2 ;POINT TO BEGINNING OF BUFF CMP R3,R2 ;BUFFER EMPTY? BEQ $WAIT ;YES, JUST CLOSE IT BR 2$ 1$: CLRB (R3)+ ;ZERO THE BUFFER FIRST 2$: CMP R3,R1 BLO 1$ CALL POUT ;OUTPUT THE LAST BLOCK BCC $WAIT ;REPORT ANY ERRORS JMP WRTERR ; APPROPRIATELY ; CLOSE OUTPUT FILES $CLOUT: MOV #EMT+160,R1 ;GET A .CLOSE EMT ADD CHAN(R0),R1 ;INSERT THE CHANNEL # MOV R1,@PC ;GHASTLY NON-REENTRANT!!!! .CLOSE 0 ;*** MODIFIED AT RUNTIME *** RETURN .SBTTL MESSAGES ENTSEC MIXED$ .IF NDF XTIME DATTIM: .ASCII " " TIMTIM: .ASCIZ " " .ENDC FINMSG: .ASCIZ /ERRORS DETECTED: / FINMS1: .ASCIZ /FREE CORE: / FINMS2: .ASCIZ /. WORDS/ HDRTTL: .ASCII /RT-11 MACRO V/ .IF NDF XMACRO .ASCII /M/ .IFF .ASCII /S/ .ENDC GVNUM .BYTE 0 .EVEN XITSEC .IF NDF XCREF ENTSEC DPURE$ CHNSPC: .WORD 500 ;CHAIN INFO AREA .RAD50 /SY / ;NAME OF CREF .RAD50 /CREF / .RAD50 /SAV/ .WORD 1 ;OUTPUT CHANNEL .WORD 2 ;INPUT CHANNEL .RAD50 /DK / ;INPUT DEVICE .RAD50 /SY / ;TO CHAIN BACK .RAD50 /MACRO / .RAD50 /SAV/ .WORD TTLBUF XITSEC .ENDC .SBTTL I/O TABLES ;IO FLAGS IO.NNU= 000001 ;NON-NULL DEVICE IO.TTY= 000002 ;DEVICE IS TTY IO.EOF= 000004 ;END-OF-FILE IO.ERR= 000010 ;ERROR ENTSEC IMPUR$ IOFTBL: .BLKW MAXCHN/2 ;I/O FLAG TABLE RECNUM: .BLKW MAXCHN/2 ;RECORD NUMBER ENTSEC DPURE$ IOLTBL: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .BYTE ZBUF'LEN,ZTYPE .NLIST .ENDM GENCHN CNTTBL: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .WORD ZCHAN'DAT .NLIST .ENDM GENCHN BUFTBL: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .WORD ZBUF'BUF .NLIST .ENDM GENCHN ENTSEC MIXED$ .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .IF NZ ZTYPE .WORD ZTYPE ;PROTOCOL WORDS FOR BINARY OUTPUT .WORD 0 .ENDC ZBUF'BUF: .BLKW /2 .NLIST .ENDM GENCHN PTRTBL= .+4 BLKTBL= .+6 .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST ZCHAN'DAT: .WORD 0 .WORD ZBUF'BUF .WORD 0 .IF NB ZBLK .WORD ZBLK'BLK .IFF .WORD 0 .ENDC .NLIST .ENDM GENCHN CHAN: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .WORD ZRTCHN .NLIST .ENDM GENCHN .SBTTL FINIS ENTSEC IMPUR$ IMPURT: XITSEC .END START .TITLE PST V02-11 PERMANENT SYMBOL TABLE 4-SEP-75 .IDENT /V0211/ .NLIST ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; ; ;CHANGED BY JD FOR LSI,SEPT 2,75 .LIST ; 15 NOV 72 .GLOBL PSTBAS, PSTTOP ;LIMITS .GLOBL WRDSYM ;POINTER TO .WORD DR1= 200 ;DESTRUCTIVE REFERENCE IN FIRST FIELD DR2= 100 ;DESTRUCTIVE REFERENCE IN SECOND FIELD .GLOBL DFLGEV, DFLGBM, DFLCND, DFLMAC, DFLSMC DFLGEV= 020 ;DIRECTIVE REQUIRES EVEN LOCATION DFLGBM= 010 ;DIRECTIVE USES BYTE MODE DFLCND= 004 ;CONDITIONAL DIRECTIVE DFLMAC= 002 ;MACRO DIRECTIVE DFLSMC= 001 ;MCALL .IF DF PAL11R ;PAL11R SUBSET XMACRO= 0 X40= 0 X45= 0 .ENDC .IIF DF X40&X45, XFLTG= 0 .IIF DF XMACRO, XSML= 0 ;NAME: RAD50 NAME OF OPCODE ;CLASS: TYPE OF PDP-11 INSTRUCTION ;VALUE: OPCODE ;FLAGS: DR1;1 FIELD INST.,DES.DESTROYED ; DR2:2 FIELDS ,DES. DESTROYED ;COND: OPERATIONS PARTICULAR TO A ; MACHINE .MACRO OPCDEF NAME, CLASS, VALUE, FLAGS, COND .IF NB .IF DF COND .MEXIT .ENDC .ENDC .RAD50 /NAME/ .BYTE FLAGS+0 .GLOBL OPCL'CLASS .BYTE 200+OPCL'CLASS .WORD VALUE .ENDM .MACRO DIRDEF NAME, FLAGS, COND .RAD50 /.'NAME/ .BYTE FLAGS+0, 0 .IF NB .IF DF COND .GLOBL OPCERR .WORD OPCERR .MEXIT .ENDC .ENDC .GLOBL NAME .WORD NAME .ENDM PSTBAS: ;BASE OPCDEF , 01, 170600, DR1, X45 OPCDEF , 01, 170600, DR1, X45 OPCDEF , 01, 005500, DR1 OPCDEF , 01, 105500, DR1 OPCDEF , 02, 060000, DR2 OPCDEF , 11, 172000, DR2, X45 OPCDEF , 11, 172000, DR2, X45 OPCDEF , 09, 072000, DR2, X40&X45 OPCDEF , 09, 073000, DR2, X40&X45 OPCDEF , 01, 006300, DR1 OPCDEF , 01, 106300, DR1 OPCDEF , 01, 006200, DR1 OPCDEF , 01, 106200, DR1 OPCDEF , 04, 103000, OPCDEF , 04, 103400, OPCDEF , 04, 001400, OPCDEF , 04, 002000, OPCDEF , 04, 003000, OPCDEF , 04, 101000, OPCDEF , 04, 103000, OPCDEF , 02, 040000, DR2 OPCDEF , 02, 140000, DR2 OPCDEF , 02, 050000, DR2 OPCDEF , 02, 150000, DR2 OPCDEF , 02, 030000, OPCDEF , 02, 130000, OPCDEF , 04, 003400, OPCDEF , 04, 103400, OPCDEF , 04, 101400, OPCDEF , 04, 002400, OPCDEF , 04, 100400, OPCDEF , 04, 001000, OPCDEF , 04, 100000, OPCDEF , 00, 000003, , X45 OPCDEF
, 04, 000400, OPCDEF , 04, 102000, OPCDEF , 04, 102400, OPCDEF , 00, 000257, OPCDEF , 00, 170000, , X45 OPCDEF , 00, 000241, OPCDEF , 00, 000250, OPCDEF , 01, 005000, DR1 OPCDEF , 01, 105000, DR1 OPCDEF , 01, 170400, DR1, X45 OPCDEF , 01, 170400, DR1, X45 OPCDEF , 00, 000242, OPCDEF , 00, 000244, OPCDEF , 02, 020000, OPCDEF , 02, 120000, OPCDEF , 11, 173400, , X45 OPCDEF , 11, 173400, , X45 OPCDEF , 00, 000254, OPCDEF , 01, 005100, DR1 OPCDEF , 01, 105100, DR1 OPCDEF , 01, 005300, DR1 OPCDEF , 01, 105300, DR1 OPCDEF
, 07, 071000, DR2, X40&X45 OPCDEF , 11, 174400, DR2, X45 OPCDEF , 11, 174400, DR2, X45 OPCDEF , 06, 104000, OPCDEF , 03, 075000, DR1, X40 OPCDEF , 03, 075030, DR1, X40 OPCDEF , 03, 075020, DR1, X40 OPCDEF , 03, 075010, DR1, X40 OPCDEF , 00, 000000, OPCDEF , 01, 005200, DR1 OPCDEF , 01, 105200, DR1 OPCDEF , 00, 000004, OPCDEF , 01, 000100, OPCDEF , 05, 004000, DR1 OPCDEF , 11, 177400, DR2, X45 OPCDEF , 11, 177400, DR2, X45 OPCDEF , 14, 177000, DR2, X45 OPCDEF , 14, 177000, DR2, X45 OPCDEF , 14, 177000, DR2, X45 OPCDEF , 14, 177000, DR2, X45 OPCDEF , 11, 172400, DR2, X45 OPCDEF , 14, 176400, DR2, X45 OPCDEF , 11, 172400, DR2, X45 OPCDEF , 01, 170100, , X45 OPCDEF , 00, 170004, , X45 OPCDEF , 00, 170003, , X45 OPCDEF , 10, 006400, , X45 OPCDEF , 01, 106500, , X45 OPCDEF , 01, 006500, , X45 OPCDEF , 01, 106700, DR1, XLSI OPCDEF , 11, 171400, DR2, X45 OPCDEF , 11, 171400, DR2, X45 OPCDEF , 02, 010000, DR2 OPCDEF , 02, 110000, DR2 OPCDEF , 01, 106600, DR1, X45 OPCDEF , 01, 006600, DR1, X45 OPCDEF , 01, 106400, , XLSI OPCDEF , 07, 070000, DR2, X40&X45 OPCDEF , 11, 171000, DR2, X45 OPCDEF , 11, 171000, DR2, X45 OPCDEF , 01, 005400, DR1 OPCDEF , 01, 105400, DR1 OPCDEF , 01, 170700, DR1, X45 OPCDEF , 01, 170700, DR1, X45 OPCDEF , 00, 000240, OPCDEF , 00, 000005, OPCDEF , 01, 006100, DR1 OPCDEF , 01, 106100, DR1 OPCDEF , 01, 006000, DR1 OPCDEF , 01, 106000, DR1 OPCDEF , 00, 000002, OPCDEF , 03, 000200, DR1 OPCDEF , 00, 000006, , X45 OPCDEF , 01, 005600, DR1 OPCDEF , 01, 105600, DR1 OPCDEF , 00, 000277, OPCDEF , 00, 000261, OPCDEF , 00, 000270, OPCDEF , 00, 170011, , X45 OPCDEF , 00, 170001, , X45 OPCDEF , 00, 170002, , X45 OPCDEF , 00, 170012, , X45 OPCDEF , 00, 000262, OPCDEF , 00, 000264, OPCDEF , 08, 077000, DR1, X45 OPCDEF , 13, 000230, , X45 OPCDEF , 00, 170005, , X45 OPCDEF , 00, 170006, , X45 OPCDEF , 12, 176000, DR2, X45 OPCDEF , 12, 175400, DR2, X45 OPCDEF , 12, 175400, DR2, X45 OPCDEF , 12, 176000, DR2, X45 OPCDEF , 12, 175400, DR2, X45 OPCDEF , 12, 175400, DR2, X45 OPCDEF , 12, 174000, DR2, X45 OPCDEF , 12, 175000, DR2, X45 OPCDEF , 12, 174000, DR2, X45 OPCDEF , 01, 170200, DR1, X45 OPCDEF , 00, 170007, , X45 OPCDEF , 01, 170300, DR1, X45 OPCDEF , 02, 160000, DR2 OPCDEF , 11, 173000, DR2, X45 OPCDEF , 11, 173000, DR2, X45 OPCDEF , 01, 000300, DR1 OPCDEF , 01, 006700, DR1, X45 OPCDEF , 06, 104400, OPCDEF , 01, 005700, OPCDEF , 01, 105700, OPCDEF , 01, 170500, , X45 OPCDEF , 01, 170500, , X45 OPCDEF , 00, 000001, OPCDEF , 05, 074000, DR2, X45 DIRDEF , DFLGBM DIRDEF , DFLGBM DIRDEF , , XREL DIRDEF DIRDEF , DFLGEV DIRDEF , DFLGBM DIRDEF , , XREL .IF DF YPHASE DIRDEF .ENDC DIRDEF DIRDEF DIRDEF DIRDEF , DFLCND DIRDEF , DFLMAC, XMACRO DIRDEF , DFLMAC, XMACRO DIRDEF DIRDEF DIRDEF DIRDEF , DFLGEV, XFLTG DIRDEF , DFLGEV, XFLTG DIRDEF , , XREL DIRDEF DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF DIRDEF , DFLMAC, XMACRO DIRDEF , DFLMAC, XMACRO DIRDEF , DFLGEV, XREL DIRDEF DIRDEF , DFLMAC, XMACRO DIRDEF , DFLMAC, XMACRO DIRDEF , DFLSMC, XSML DIRDEF , , XMACRO DIRDEF , , XMACRO DIRDEF , , XMACRO DIRDEF DIRDEF , , XMACRO DIRDEF DIRDEF .IF DF YPHASE DIRDEF .ENDC DIRDEF .IF DF RSX11D DIRDEF .ENDC DIRDEF DIRDEF , DFLGEV .IF NDF XBAW DIRDEF .ENDC DIRDEF , DFLMAC, XMACRO DIRDEF DIRDEF WRDSYM: DIRDEF <WORD >, DFLGEV PSTTOP: ;TOP LIMIT .END 7�������������������������������; RT-11 MACRO EXPAND V02-02 ; ; DEC-11-OREXA-E ; ; AUGUST 26, 1974 ; ; ERIC PETERS ; ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; .SBTTL PREPAS PARAMETER FILE RT11= 0 ��������������������������������������������� .TITLE PPARAM V02-02 26-AUG-74 .SBTTL COMMON PARAMETER FILE .IDENT /V0201/ .MACRO GVNUM ;GEN VERSION NUMBER .ASCII /V02-02/ .ENDM ; ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. .NLIST BEX .IIF NDF MCEXEC, .NLIST R0= %0 R1= %1 R2= %2 R3= %3 R4= %4 R5= %5 SP= %6 PC= %7 .SBTTL ASSEMBLY OPTIONS ;THE FOLLOWING MACRO CAUSES ASSEMBLY OPTIONS TO BE ;PRINTED ON THE LOADER MAP AND ANY IMPLICATIONS ;(SECOND ARGUMENT) TO BE DEFINED. OPTIONS ARE ;SELECTED BY EQUATING THEM TO ZERO. .MACRO LDRMAP MNE,IMPLIES .IF DF MNE .LIST ; .GLOBL MNE .NLIST .IRP X,<IMPLIES> X= 0 ;INVOKE IMPLICATIONS .ENDM .ENDC .ENDM LDRMAP ;THE FOLLOWING GROUP ENABLES FUNCTIONS LDRMAP RT11 LDRMAP DEBUG ;DEBUG VERSION LDRMAP EIS ;PDP-11/45 INSTRUCTIONS ;THE FOLLOWING GROUP DISABLES FUNCTIONS LDRMAP XSML ;SYSTEM MACROS LDRMAP BRERR ;BRIEF SYSTEM ERRORS(RT11) .SBTTL VARIABLE PARAMETERS ;THE FOLLOWING PARAMETERS CAN BE MODIFIED ;AT ASSEMBLY TIME. .MACRO PARAM MNE, VALUE ;DEFINE DEFAULT PARAMETERS .IIF NDF MNE, MNE= VALUE .LIST MNE= MNE .NLIST .ENDM PARAM SRCLEN, 132. ;SOURCE STATEMENT LENGTH LINLEN= SRCLEN PARAM TMPLEN, SRCLEN+80. PARAM SMLLEN, 80. PARAM USRSIZ, 2*2560.+2 PARAM STKFDG, SRCLEN+100. .SBTTL GLOBALS ;GLOBALS DEFINED IN PREPAS .GLOBL PREPAS .GLOBL DNC, MOVBYT, SAVREG .GLOBL ERRCNT ;GLOBALS DEFINED IN MCEXEC .IF NDF XSML .GLOBL FINSML, INISML .ENDC .GLOBL GETPLI .GLOBL IO.EOF, IO.TTY, IO.ERR .GLOBL AVAIL, SERROR .GLOBL TSTSTK .GLOBL IOFTBL, CNTTBL, BUFTBL .SBTTL SECTOR INITIALIZATION ;SECTORS ARE ENTERED THROUGH THE MACRO ; "ENTSEC", SPECIFYING THE SECTOR NAME FOR THE ;ARGUMENT. THE MACRO "XITSEC" RETURNS TO ;THE DEFAULT SECTOR, "MAIN". THE NULL .CSECT IS ;NEVER USED. .MACRO ENTSEC NAME ;INIT A SECTION .CSECT NAME .ENDM .MACRO XITSEC ;EXIT TO DEFAULT SECTION .CSECT MAIN .ENDM ENTSEC DPURE ;D-SPACE, PURE ENTSEC DPURE$ ENTSEC MIXED$ ;MIXED PURE AND IMPURE TAB= 11 LF= 12 VT= 13 FF= 14 CR= 15 SPACE= 40 .SBTTL SUBROUTINE CALL DEFINITIONS ;THE MACRO "CALL" IS THE EQUIVALENT OF "JSR PC," AND ;IS USED FOR SIMPLICITY. THE MACRO "RETURN" IS THE ;EQUIVALENT OF "RTS PC". .MACRO CALL ADDRESS JSR PC,ADDRESS .ENDM .MACRO RETURN RTS PC .ENDM .SBTTL MISCELLANEOUS MACRO DEFINITIONS .MACRO SERROR NUM,MSG ENTSEC CHARPT= . .ASCIZ "?MSG?" XITSEC JSR R5,SERROR .WORD CHARPT .ENDM XITSEC .IIF NDF MCEXEC, .LIST �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������; PREXEC.MAC V02-02 .NLIST ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. .LIST .SBTTL ****EXEC**** .GLOBL START,CONT MCEXEC=0 .MCALL .SETTOP,.WAIT,.CLOSE,.SRESET,.LOOKUP,.CSIGEN .MCALL .PRINT,.RCTRLO .MCALL ..V1.. ..V1.. EMTERR=52 USRLOC=266 ;OFFSET FROM RMON TO USR LOCATION WORD MONLOW=54 HIGHAD=50 ENTSEC IMPUR$ IMPUR$: .MACRO XITSEC ;OVER-RIDE FOR EXEC .CSECT MAIN$ .ENDM XITSEC XITSEC .SBTTL PROGRAM START BR ERRB ;REENTRY POINT START: MOV @#MONLOW,R1 ;LOWER LIMIT OF RESIDENT MOV USRLOC(R1),R1 ;GET BOTTOM ADRS OF USR [RRB 27-JUN-74] TST -(R1) ;AND GET BELOW IT .SETTOP R1 MOV @#HIGHAD,STKSAV ;INIT FOR STACK [RRB 27-JUN-74] CONT: MOV #IMPUR$,R1 ;CLEAR IMPURE AREA 1$: CLR (R1)+ CMP R1,#IMPURT BLO 1$ MOV STKSAV,SP ;AND INIT THE STACK MOV #CTLTBL,R0 2$: MOV (R0)+,R1 ;GET ADDR OF NEXT ROUTINE TO EXEC MOV R0,-(SP) ;SAVE POINTER CALL (R1) ;EXEC NEXT ROUTINE MOV (SP)+,R0 ;RETRIEVE POINTER BR 2$ ENTSEC DPURE$ CTLTBL: ;TABLE TO EXEC ASSEMBLER .WORD INIOF, PREPAS .WORD SETDN ;GO TO RESTART POINT XITSEC ERRB: JMP ERR .SBTTL INIT OUTPUT FILES .ENABL LSB INIOF: MOV PRGLIM+2,R0 ;GET UPPER LIMIT OF CODE .CSIGEN R0,#DEFEXT,#0 MOV R0,R1 .WAIT 0 ;TEST OUTPUT FILE BCS 1$ ;ERROR - NO FILE BIS #IO.NNU,IOFTBL+TMPCHN .WAIT 1 BCC 1$ ;ERROR -TOO MANY OUTPUT FILES .WAIT 2 BCC 1$ .WAIT 3 ;TEST 1ST INPUT CHANNEL BCS 2$ ;ERROR - NO INPUT MOV R1,AVAIL ;SET UP SPACE FOR TABLE MOV (SP)+,R0 ;SWITCH COUNT FROM CSI BNE 3$ MOV BLKTBL+<SRCCHN*4>,PTRTBL+<SRCCHN*4> MOV #BLKTBL+<TMPCHN*4>,R0 MOV @R0,-(R0) SUB #1000,@R0 MOV #3,CHAN+SRCCHN ;START WITH CHANNEL THREE RETURN 1$: SERROR OF,<WRONG NUMBER OF OUTPUT FILES> 2$: SERROR NIF,<NO INPUT FILE> 3$: SERROR BSW,<BAD SWITCH> .DSABL LSB ENTSEC DPURE$ PRGLIM: .LIMIT DEFEXT: .RAD50 /MAC/ .RAD50 /PAL/ .WORD 0,0 XITSEC .SBTTL FINISH ASSEMBLY AND RESTART SETDN: MOV #FINMSG,R1 ;ERRORS DETECTED MESSAGE MOV #LINBUF,R2 CALL MOVBYT ;MOVE MESSAGE MOV ERRCNT,R1 ;NUMBER OF ERRORS CALL DNC ;CONVERT TO DECIMAL CLRB @R2 ;SET STOPPER FIN: $CLOUT TMP .PRINT #LINBUF ERR: CLR R0 .SRESET .RCTRLO ;RESET CTRL-O EFFECT [RRB 27-JUN-74] JMP CONT ENTSEC MIXED$ LINBUF: .BLKB SRCLEN .EVEN XITSEC SERROR: .PRINT @R5 BR ERR .SBTTL MEMORY MANAGMENT TSTSTK: MOV #-STKFDG,-(SP) ;TEST IF STACK OVERFLOWED ADD SP,@SP CMP AVAIL,(SP)+ BHIS 1$ RETURN 1$: SERROR COR,<INSUFFICIENT CORE> ENTSEC MIXED$ STKSAV: .BLKW XITSEC .SBTTL GET PHYSICAL SOURCE LINE WINST=EMT+240 GETPLI: $READW SRC CLR R0 BIT #IO.EOF,IOFTBL+SRCCHN ;END OF FILE? BEQ 2$ ;NO MOV CHAN+SRCCHN,R0 ;GET CURRENT INPUT CHAN INC R0 ;MOVE TO NEXT CHAN CMP R0,#8. ;LAST CHAN? BHI 1$ ;YES, FLAG END OF INPUT CLR RECNUM+SRCCHN ;RESET RECORD (BLK) NUMBER MOV BLKTBL+<SRCCHN*4>,PTRTBL+<SRCCHN*4> MOV R0,CHAN+SRCCHN BIS #WINST,R0 ;CREATE A WAIT CALL FOR NEXT CHAN MOV R0,@PC ;AND STORE IN NEXT LOCATION .WAIT 0 BCS 1$ ;BRANCH IF NO MORE INPUT MOV #-1,R0 ;FLAG END OF FILE 2$: RETURN 1$: MOV #1,R0 ;FLAG END OF INPUT RETURN .SBTTL SYSTEM MACRO HANDLERS .IF NDF XSML .ENABL LSB INISML: TST SMLSW ;NEW CALL? BNE FINSML ;NO, EXIT INC SMLSW ;SET SWITCH CLR RECNUM+SMLCHN ;RESET RECORD # .WAIT 16 ;CHANNEL ALREADY OPEN? BCC 1$ ;YES .LOOKUP 16,#SMDBLK ;LOOK UP SYSTEM MACRO FILE BCS 2$ ;SOMETHING WRONG 1$: MOV #BLKTBL+<SMLCHN*4>,R0 MOV @R0,-(R0) ;SET BUF PTR TO EMPTY MOV SP,R0 ;SIGNAL GOOD (NON-ZERO) RETURN RETURN FINSML: 2$: CLR R0 ;SIGNAL DONE CLR SMLSW ;CLEAR SWITCH RETURN .DSABL LSB ENTSEC DPURE$ SMDBLK: .RAD50 /SY/ ;DEVBLK FOR SYSTEM MACRO FILE .RAD50 /SYSMAC/ .RAD50 /8K/ ENTSEC MIXED$ .BLKW 256. ;BUFFER FOR SYSTEM MACROS SMLBLK: ENTSEC IMPUR$ SMLSW: .BLKW XITSEC .ENDC .SBTTL WRITE ROUTINES $WRITW: $WRITE: JSR R4,SAVE ;SAVE REGISTERS BIC #IO.EOF!IO.ERR,IOFTBL(R0) ;CLEAR FLAGS MOV CNTTBL(R0),R4 MOV (R4)+,R1 ;ACTUAL BYTE COUNT MOV (R4)+,R2 ;LOGICAL BUFFER POINTER MOV (R4)+,R3 ;PHYSICAL BUFFER POINTER ; R4 NOW POINTS TO PHYSICAL BUFFER END POINTER TSTB IOLTBL+1(R0) ;BINARY MODE? BNE 3$ ;YES 1$: MOVB (R2)+,(R3)+ ;MOVE LINE CMP R3,@R4 ;END OF PHYSICAL BUFFER BLO 2$ ;NO CALL POUT ;YES; PERFORM WRITE BCS 8$ ;EXIT IF ERRORS 2$: DEC R1 BNE 1$ ;LOOP UNTIL LINE FINISHED MOV R3,-(R4) ;UPDATE BUFFER POINTER RETURN ; FORMATTED BINARY WRITE 3$: HALT ;NOT AVAILABLE IN THIS COPY 8$: SERROR ODF,<OUTPUT DEVICE FULL> .SBTTL READ ROUTINE $READW: $READ: JSR R4,SAVE ;SAVE REGISTERS BIC #IO.EOF!IO.ERR,IOFTBL(R0) ;CLEAR FLAGS CLR R1 ;BYTE COUNT MOV CNTTBL(R0),R4 TST (R4)+ MOV (R4)+,R2 ;LINE BUFFER POINTER MOV (R4)+,R3 ;PHYSICAL BUFFER POINTER ; R4 NOW POINTS TO PHYSICAL BUFFER END POINTER MOV R5,-(SP) 1$: CMP R3,@R4 ;INPUT BUFFER EMPTY? BLO 2$ ;NO CALL PIN ;YES, FILL IT BCS 4$ ;ERROR OR EOF 2$: MOVB (R3)+,R5 ;GET NEXT BYTE BIC #177600,R5 ;STRIP ASCII TO 7 BITS INC R1 ;ASSUME GOOD CHAR MOVB R5,(R2)+ ;STUFF IT INTO LINE CMPB R5,#SPACE ;GOOD CHAR? BLO 3$ ;BRANCH IF SPECIAL CHAR CMPB R5,#173 ;IGNORE CHAR? BHIS 6$ CMPB R1,IOLTBL(R0) ;LINE TOO LONG? BLO 1$ ;OKAY BIS #IO.ERR,IOFTBL(R0) ;FLAG ERROR MOVB #LF,-(R2) ;INSERT A LINE TERMINATOR BR 4$ 3$: CMPB R5,#LF ;LINE TERMINATOR? BNE 5$ ;TRY AGAIN 4$: MOV R1,@CNTTBL(R0) ;YES, END OF LINE MOV R3,-(R4) ;UPDATE PHYSICAL BUF PTR MOV (SP)+,R5 RETURN 5$: CMPB R5,#CR ;LEAVE <CR> ALONE BEQ 1$ CMPB R5,#TAB ;LEAVE TABS BEQ 1$ CMPB R5,#FF ;ALTERNATE LINE TERMINATOR? BEQ 4$ ;YES 6$: DEC R1 ;NO, IGNORE ALL OTHER CHARS DEC R2 ;REMOVE FROM BUFFER BR 1$ SAVE: MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) CALL @R4 MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 RETURN .SBTTL COMMON I/O ROUTINES POUT: MOV R1,-(SP) MOV #EMT+220,R1 ;PLACE WRITE EMT INTO R1 BR PIO PIN: MOV R1,-(SP) MOV #EMT+200,R1 ;PLACE READ EMT INTO R1 PIO: MOV R0,-(SP) CLR -(SP) ;BEGIN SETTING UP MONITOR CALL MOV #256.,-(SP) ;WORD COUNT MOV @R4,R3 ;GET BUFFER END POINTER SUB #512.,R3 ;NOW POINT TO BEGINNING MOV R3,-(SP) ADD CHAN(R0),R1 ;CREATE PROPER EMT MOV RECNUM(R0),R0 ;BLOCK NUMBER MOV R1,@PC ;STORE EMT IN NEXT LOCATION EMT 220 ;MODIFIED AT RUNTIME!!!!!!!! MOV (SP)+,R0 MOV (SP)+,R1 INC RECNUM(R0) BCC $WAIT ;NORMAL RETURN TSTB @#EMTERR ;ZERO IF EOF BEQ 2$ BIS #IO.ERR,IOFTBL(R0) ;FLAG BAD ERROR BR 3$ 2$: BIS #IO.EOF,IOFTBL(R0) ;FLAG END OF FILE 3$: SEC $WAIT: RETURN ; CLOSE OUTPUT FILES $CLOUT: TST IOFTBL(R0) ;ANYTHING TO DO? BEQ 4$ MOV CNTTBL(R0),R4 CMP (R4)+,(R4)+ MOV (R4)+,R3 ;BUFFER POINTER MOV @R4,R1 ;END OF BUFFER MOV R1,R2 SUB #512.,R2 ;POINT TO BEGINNING OF BUFF CMP R3,R2 ;BUFFER EMPTY? BEQ 3$ ;YES, JUST CLOSE IT BR 2$ 1$: CLRB (R3)+ ;ZERO THE BUFFER FIRST 2$: CMP R3,R1 BLO 1$ CALL POUT ;OUTPUT THE LAST BLOCK 3$: MOV #EMT+160,R1 ;CLOSE EMT ADD CHAN(R0),R1 ;PLUS CHANNEL MOV R1,@PC ;PLACE INTO INSTRUCTION STREAM .CLOSE 0 ;MODIFIED AT RUNTIME 4$: RETURN .SBTTL MESSAGES ENTSEC MIXED$ FINMSG: .ASCIZ /ERRORS DETECTED: / .EVEN XITSEC .SBTTL BUFFERS ENTSEC MIXED$ .BLKW 256. SRCBLK: .BLKW 256. TMPBLK: XITSEC .SBTTL I/O TABLES ;IO FLAGS IO.NNU= 000001 ;NON-NULL DEVICE IO.TTY= 000002 ;DEVICE IS TTY IO.EOF= 000004 ;END-OF-FILE IO.ERR= 000010 ;ERROR ENTSEC IMPUR$ IOFTBL: .BLKW MAXCHN/2 ;I/O FLAG TABLE RECNUM: .BLKW MAXCHN/2 ;RECORD NUMBER ENTSEC DPURE$ IOLTBL: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .BYTE ZBUF'LEN,ZTYPE .NLIST .ENDM GENCHN CNTTBL: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .WORD ZCHAN'DAT .NLIST .ENDM GENCHN BUFTBL: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .WORD ZBUF'BUF .NLIST .ENDM GENCHN ENTSEC MIXED$ .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .IF NZ ZTYPE .WORD ZTYPE ;PROTOCOL WORDS FOR BINARY OUTPUT .WORD 0 .ENDC ZBUF'BUF: .BLKW <ZBUF'LEN+1>/2 .NLIST .ENDM GENCHN PTRTBL= .+4 BLKTBL= .+6 .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST ZCHAN'DAT: .WORD 0 .WORD ZBUF'BUF .WORD 0 .IF NB ZBLK .WORD ZBLK'BLK .IFF .WORD 0 .ENDC .NLIST .ENDM GENCHN CHAN: .MACRO SETCHN ZCHAN,ZBUF,ZBLK,ZRTCHN,ZTYPE .LIST .WORD ZRTCHN .NLIST .ENDM GENCHN .SBTTL FINIS ENTSEC IMPUR$ IMPURT: XITSEC .END START �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. C C C MAIN DRIVER ROUTINE FOR PATCHO C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF LOGICAL*4 WORD,DECSW INTEGER*2 IFBBUF(25),MODNAM(2),CMBLK(12) COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL,PREVIREC,PREVIPTR COMMON /CS/ NAME1(2),VALUE1,NAME2(2),VALUE2,RELATV,WORD,CMDNMB COMMON /CS/ CHKSUM,DECSW COMMON /SECTBL/ SECMAX !TO PULL SECTBL INTO THE ROOT COMMON /CHGTBL/ CHGMAX !AND ALSO CHGTBL EQUIVALENCE (CMBLK,NAME1) DATA OPENFL/-1/ !INDICATES IF A FILE IS OPEN YET DATA BUFFUL/0/ !INDICATES WHETHER A BLOCK IS PRESENT IN FBBUF DATA CHANGE/0/ !INDICATES IF A CHANGE HAS BEEN MADE DATA CMBLK/12*0/ !INITIALIZE SCAN COMMON BLOCK DATA LSTMOD /-1/ !LIST MODE SWITCH, INITIALLY OFF DATA ERROR,EOF /F,F/ !ERROR AND END-OF-FILE FLAGS DATA IPTR,OPTR /513,1/ !BUFFER POINTERS DATA IREC,OREC /1,1/ !AND RECORD NUMBERS DATA SECMAX/0/, CHGMAX/0/ !INIT # OF CSECTS, CHANGES C C 10 CALL GETCMD !GET NEXT COMMAND IF (CMDNMB.NE.6.AND.OPENFL) GOTO 900 !OOPS - NO FILE OPEN GOTO (100,200,300,400,400,600,700),CMDNMB 100 IF (CHANGE) CALL CLOSEF !DUMP ANY CHANGES MADE SO FAR CHANGE = 0 !INDICATE CLEAN STATE CALL POINT GOTO 10 200 CALL LIST GOTO 10 300 CALL DUMP GOTO 10 400 CALL WRDBYT CHANGE = -1 !INDICATE A CHANGE PENDING GOTO 10 600 DEFINE FILE 1(0,256,U,IREC) DEFINE FILE 2(0,256,U,OREC) CALL INBLK !GET FIRST BLOCK CALL NEXT !AND SET UP NAME OF MODULE OPENFL = 0 !ALLOW OTHER COMMANDS NOW GOTO 10 700 IF (CHANGE) CALL CLOSEF 710 IF (EOF) GOTO 720 !UNTIL DONE CALL OUTBLK !ELSE KEEP COPYING CALL INBLK GOTO 710 720 IF (BUFFUL) CALL OUTBLK !DUMP LAST BUFFER IF NECESSARY IF (OPTR.EQ.1) GOTO 740 !IF OUTPUT BUFFER EMPTY DO 730 L=OPTR,512 !ZERO REMAINDER OF BUFFER 730 OBUF(L) = .FALSE. WRITE (2'OREC) OBUF !AND WRITE IT 740 TYPE 1010 !CHECKSUM TO ASSURE PATCH TYPED CORRECTLY 1010 FORMAT('+ENTER CHECKSUM: ',$) IF (DECSW) GOTO 800 !IF HE DOESN'T KNOW THE CHECKSUM ACCEPT 1020,CHK1 !ELSE READ IT FROM THE CONSOLE 1020 FORMAT(O6) IF (CHK1.NE.CHKSUM) PAUSE '?BAD PATCH?' STOP 800 TYPE 1030,CHKSUM !TYPE OUT CALCULATED CHECKSUM 1030 FORMAT('+',O6) STOP 900 TYPE 1000 1000 FORMAT('+?NO FILE OPEN?',/) GOTO 10 END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. C SUBROUTINE GETCMD C C DUMMY ROUTINE TO ALLOW /SCAN/ TO BE IN OVERLAY C CALL COMMND END INTEGER FUNCTION OCTIN(VALUE) C C THIS FUNCTION GETS A OCTAL CONSTANT FROM THE COMMAND C AND RETURNS ITS VALUE IN VALUE. IF THE ENTIRE CONSTANT C IS ILLEGAL, THEN FALSE IS RETURNED AS THE VALUE OF C THE FUNCTION, OTHERWISE TRUE IS RETURNED. C IMPLICIT INTEGER(A-Z) LOGICAL*1 TEXT COMMON /SCAN/ TEXT(80), PTR, CHAR OCTIN = 0 !INDICATE FALSE VALUE = 0 !AND INITIALIZE VALUE DIGCNT = 0 !INITIALIZE DIGIT COUNT FCHAR = 0 !INITIALIZE FIRST CHAR. IF (NUMBER(GNB()).EQ.0) GOTO 3 !IF NOT NUMERIC 1 IF (CHAR.GT."67) GOTO 3 !IF NOT OCTAL CHARACTER VAL8 = VALUE*2 + VALUE*2 + VALUE*2 + VALUE*2 VALUE = VAL8 + CHAR - "60 !ACCUMULATE VALUE IF (DIGCNT.NE.0) GOTO 5 IF (VALUE-1) 2,4,5 !CHECK FIRST DIGIT 4 FCHAR=VALUE !SAVE FIRST DIGIT 5 DIGCNT = DIGCNT + 1 !BUMP DIGIT COUNT 2 IF (DIGCNT-6) 7,6,3 !ONLY 6 DIGITS 6 IF (FCHAR.NE.1) GOTO 3 !IF 6 DIGS-FIRST MST BE 1 7 IF (NUMBER(GNB())) GOTO 1 !CONTINUE UNTIL NON-NUMERIC OCTIN = -1 !INDICATE OCTAL CONSTANT FOUND 3 RETURN END SUBROUTINE SKPBLK IMPLICIT INTEGER(A-Z) C THIS SUBROUTINE SKIPS BLANK CHARACTERS IN THE INPUT C LINE AND PUSHES THE POINTER PAST THEM. LOGICAL*1 LINE COMMON /SCAN/ LINE(80), PTR DO 1 PTR=PTR, 80 1 IF(LINE(PTR) .NE. "40)RETURN PTR=80 CALL GNB RETURN END SUBROUTINE GETNAM(BUFFER, LENGTH) C THIS SUBROUTINE COLLECTS A NAME FROM THE INPUT LIST, PUTTING C THE CHARACTERS IN 'BUFFER'. THE NUMBER OF CHARACTERS C IS RETURNED IN LENGTH. IMPLICIT INTEGER(A-Z) LOGICAL*1 LINE COMMON /SCAN/ LINE(80), PTR, CHAR LOGICAL*1 BUFFER(6) DO 2 I=1, 6 2 BUFFER(I)="40 !BLANK-FILL BUFFER CALL SKPBLK LENGTH=0 IF(ALPHA(GNB()).EQ.0)RETURN !IF NEXT NOT ALPHABETIC DO 1 LENGTH=1, 6 J=CHAR IF(CHAR .EQ. "137) J="40 !ALLOW UNDERSCORE AS BLANK BUFFER(LENGTH)=J CALL GNB J = ALPHA(CHAR).OR.NUMBER(CHAR) 1 IF (J.EQ.0) GOTO 3 !IF CHAR NOT ALPHANUMERIC, EXIT IF (J.NE.0) LENGTH=0 !IF NEXT WASN'T DELIMITER 3 RETURN END INTEGER FUNCTION GNB C THIS FUNCTION RETURNS THE NEXT CHARACTER IN THE INPUT STRING C AND INCREMENTS THE CHARACTER POINTER. THE CHARACTER IS THE C LOW BYTE ONLY OF THE STRING. IMPLICIT INTEGER(A-Z) LOGICAL*1 LINE COMMON /SCAN/ LINE(80), PTR, CHAR CHAR=LINE(PTR) PTR=PTR+1 IF(PTR .LE. 80) GOTO 2 PTR=PTR-1 CHAR="40 2 GNB=CHAR RETURN END INTEGER FUNCTION ALPHA(CHAR) C THIS FUNCTION RETURNS TRUE IF THE ARGUMENT IS ALPHABETIC IMPLICIT INTEGER (A-Z) INTEGER CHAR ALPHA=CHAR .GE. "101 .AND. CHAR .LE. "132 1.OR.CHAR .EQ. "44 .OR. CHAR .EQ. "56 .OR. CHAR .EQ. "137 RETURN END INTEGER FUNCTION NUMBER(CHAR) C THIS FUNCTION RETURNS TRUE IF 'CHAR' IS A NUMBER INTEGER CHAR NUMBER = CHAR.GE."60 .AND. CHAR.LE."71 RETURN END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. C SUBROUTINE COMMND C THIS IS THE COMMAND RECOGNIZER SUBROUTINE FOR PATCHO. IT READS C A LINE FROM THE TTY, DETERMINSE THE TYPE OF THE COMMAND, AND C GOES OFF TO PROCESS IT. VALUES ARE RETURNED THRU THE LABELED C COMMON BLOCK 'CS'. IMPLICIT INTEGER(A-Z) LOGICAL*4 WORD, LTZERO, DECSW, DIGTYP INTEGER CMBLK(10) COMMON /CS/ NAME1(2), VALUE1, NAME2(2), VALUE2 COMMON /CS/ RELATV, WORD, CMDNMB, CHKSUM, DECSW EQUIVALENCE (NAME1,CMBLK) DIMENSION CMD1(9), CMD2(9), CMD3(9) LOGICAL*1 LINE DIMENSION LINE(80), BUFFER(3), INPFIL(6), OUTFIL(6) COMMON /SCAN/ LINE, PTR, CHAR DATA CMD1/'PO','LI','DU','WO','BY','OP','EX','HE', 'DE'/ DATA CMD2/'IN','ST','MP','RD','TE','EN','IT','LP', 'C '/ DATA CMD3/'T ',8*' '/ DIGTYP(CHAR)=NUMBER(CHAR).OR.CHAR .EQ. "53.OR.CHAR .EQ. "55 C C READ A COMMAND LINE AND CHECK FOR ONLY CR C 1 TYPE 102 102 FORMAT('+*',$) ACCEPT 100,LINE 100 FORMAT(80A1) WORD=.FALSE. PTR=1 DO 2 I=1, 80 2 IF(LINE(I) .NE. "40) GOTO 3 GOTO 1 C C GET THE COMMAND FROM THE LINE AND PUT IT IN THE BUFFER C 3 CALL GETNAM(BUFFER, LENGTH) IF(LENGTH .GT. 0) GOTO 5 4 TYPE 101 101 FORMAT('+?ILLEGAL COMMAND?',/) GOTO 1 C C DETERMINE WHAT COMMAND THIS IS C 5 DO 77 CMDNMB=1, 9 77 IF(BUFFER(1) .EQ. CMD1(CMDNMB)) GOTO 6 GOTO 4 6 IF(BUFFER(2) .NE. CMD2(CMDNMB) 1 .OR. BUFFER(3) .NE. CMD3(CMDNMB)) GOTO 4 C C DISPATCH ON THE CORRECT COMMAND NUMBER C GOTO(10, 15, 15, 30, 31, 40, 15, 50, 25), CMDNMB C C PROCESS THE POINT COMMAND C 10 CALL GETNAM(BUFFER, LENGTH) IF(LENGTH .LE. 0) GOTO 4 12 CALL IRAD50(6, BUFFER, NAME2) C C LOOK FOR END OF LINE AFTER OTHERWISE VALID COMMAND C 15 CALL SKPBLK IF(PTR .NE. 80) GOTO 4 17 DO 18 I=1, 10 18 CHKSUM=CHKSUM+CMBLK(I) RETURN C C THE SECRET 'DEC' COMMAND, WHICH TELLS THE PROGRAM THAT THE USER C NEEDS TO KNOW THE CORRECT CHECKSUM. C THE PROGRAM THEN WILL TYPE IT ON EXITING SO IT CAN BE PUBLISHED C THIS COMMAND ABSOLUTLY MUST BE THE 1ST COMMAND OF THE SERIES C SINCE IT ZEROS THE CHECKSUM INITIALLY. IF NOT, THE CHECKSUM WILL C NOT REFLECT ALL THE COMMANDS TYPED IN. C 25 DECSW=.TRUE. CHKSUM=0 GOTO 1 C C WORD AND BYTE COMMANDS C 30 WORD=.TRUE. 31 CMDNMB=4 RELATV=-1 CALL GETNAM(BUFFER, LENGTH) IF(LENGTH .GT. 0) GOTO 33 IF(CHAR .EQ. "53) GOTO 35 !IF CHAR = '+' NAME1(1)=0 NAME1(2)=0 IF(NUMBER(CHAR)) GOTO 73 GOTO 4 33 CALL IRAD50(6, BUFFER, NAME1) NAME2(1)=0 NAME2(2)=0 IF(CHAR .EQ. "53) GOTO 35 !IF CHAR = '+' IF(CHAR .EQ. "55) GOTO 4 !IF CHAR = '-' 34 TYPE 109 109 FORMAT('+?OFFSET?',/) GOTO 1 73 PTR=PTR-1 35 IF(OCTIN(VALUE1).EQ.0) GOTO 34 37 IF(CHAR .NE. "75) GOTO 4 !IF CHAR = '=' 39 IF(ALPHA(GNB())) GOTO 71 IF(DIGTYP(CHAR)) GOTO 74 RELATV=RELATV+1 IF(CHAR .EQ. "43) GOTO 72 !IF CHAR = '#' RELATV=RELATV+1 IF(CHAR .EQ. "45) GOTO 72 !IF CHAR = '%' GOTO 4 71 PTR=PTR-1 72 CALL GETNAM(BUFFER, LENGTH) IF(LENGTH .GT. 0) GOTO 79 IF(DIGTYP(CHAR)) GOTO 74 GOTO 4 79 CALL IRAD50(6, BUFFER, NAME2) 74 LTZERO=CHAR .EQ. "55 !IF CHAR = '-' IF(CHAR .EQ. "53 .OR. LTZERO) GOTO 75 !IF SIGN IS PRESENT IF (NUMBER(CHAR).EQ.0) GOTO 34 !IF NOT NUMERIC PTR=PTR-1 75 IF(OCTIN(VALUE2).EQ.0) GOTO 34 !IF OCTAL OFFSET NOT PRESENT IF(LTZERO) VALUE2=-VALUE2 IF(WORD .AND. (VALUE1 .AND. 1) .NE. 0) GOTO 4 GOTO 15 C C OPEN COMMAND PROCESSOR C GET BOTH FILE NAMES ON AN OPEN AND ASSIGN CHANNELS AS FOLLOWS: C 1 - INPUT FILE C 2 - OUTPUT FILE C IF ONE IS MISSING, THE SAME NOME IS USED FOR BOTH C 40 TYPE 997 !GET INPUT FILE 997 FORMAT('+ENTER INPUT FILE ',$) CALL ASSIGN(1,,-1) TYPE 998 !GET OUTPUT FILE 998 FORMAT('+ENTER OUTPUT FILE ',$) CALL ASSIGN(2,,-1) GOTO 15 C C HELP COMMAND - PRINT SOME RANDOM EXPL. OF WHATS GOING ON C 50 TYPE 105 105 FORMAT(' PATCHO V01-03 HAS THE FOLLOWING COMMANDS:',/ 1,'0BYTE DEC DUMP EXIT HELP LIST ', 2,'OPEN POINT WORD',/' %=DISPLACED, #=ABSOLUTE, ' 3,'USE "_" FOR IMBEDDED BLANKS',/) GOTO 1 END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. C SUBROUTINE INBLK C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR,CHKSUM, 1L,NXTBYT,MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL,PREVIREC,PREVIPTR EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C C FUNCTION: C INPUT NEXT FORMATTED BINARY BLOCK INTO FBBUF, SETTING C FBLEN = LENGTH (IN BYTES) OF REMAINDER OF BLOCK IN FBBUF C FBCODE = CODE (FIRST WORD) OF FB BLOCK C PREVIREC = IREC !SAVE CURRENT POSITION IN INPUT FILE PREVIPTR = IPTR !IN CASE OF LIST COMMAND 100 L = NXTBYT() IF (EOF) GOTO 998 IF (L.EQ.0) GOTO 100 IF (L.NE.1) GOTO 900 IF (NXTBYT().NE.0) GOTO 900 B1(1) = NXTBYT() !GET FBLEN B1(2) = NXTBYT() B2(1) = NXTBYT() !GET FBCODE B2(2) = NXTBYT() CHKSUM = B1(1) + B1(2) + B2(1) + B2(2) + 1 FBLEN = FBLEN - 6 !MINUS LENGTH OF HEADER, LENGTH, CODE IF (FBLEN.EQ.0) GOTO 300 DO 200 I=1,FBLEN FBBUF(I) = NXTBYT() CHKSUM = CHKSUM + FBBUF(I) 200 CONTINUE 300 IF ((NXTBYT() + CHKSUM).AND."377) GOTO 910 IF (ERROR) GOTO 900 IF (EOF) GOTO 998 !END OF FILE ISN'T NECESSARILY AN ERROR FBPTR = 1 BUFFUL = -1 !INDICATE A BLOCK IN THE BUFFER RETURN C C ERROR CONDITIONS C 900 TYPE 1000 1000 FORMAT('+?BAD OBJ?',/) GOTO 999 910 IF (EOF) GOTO 998 !SEE ABOVE TYPE 1010 1010 FORMAT('+?BAD CHECKSUM?',/) 999 ERROR = .TRUE. 998 RETURN END INTEGER FUNCTION NXTBYT*2 C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C C FUNCTION: C GET NEXT BYTE FROM THE INPUT FILE. C IF (IPTR.LE.512) GOTO 100 READ (1'IREC,END=200,ERR=300) IBUF IPTR = 1 100 NXTBYT = IBUF(IPTR) IPTR = IPTR + 1 RETURN C C END-OF-FILE REACHED ON INPUT C 200 EOF = .TRUE. RETURN C C HARDWARE ERROR ON INPUT C 300 ERROR = .TRUE. RETURN END SUBROUTINE OUTBLK C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR,CHKSUM, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C C FUNCTION: C WRITE THE FORMATTED BINARY BLOCK IN FBBUF TO THE OUTPUT FILE. C BUFFUL = 0 !INDICATE FB BUFFER EMPTY FBLEN = FBLEN + 6 !CORRECT LENGTH CHKSUM = -1 - B1(1) - B1(2) - B2(1) - B2(2) CALL OUTBYT(1) !OUTPUT FB BLOCK HEADER CALL OUTBYT(0) CALL OUTBYT(B1(1)) !OUTPUT LENGTH CALL OUTBYT(B1(2)) CALL OUTBYT(B2(1)) !OUTPUT BLOCK CODE CALL OUTBYT(B2(2)) IF (FBLEN.EQ.6) GOTO 200 DO 100 I=1,FBLEN-6 CALL OUTBYT(FBBUF(I)) !OUTPUT REMAINDER OF BLOCK CHKSUM = CHKSUM - FBBUF(I) !AND KEEP TRACK OF CHECKSUM 100 CONTINUE 200 CALL OUTBYT(CHKSUM) !OUTPUT CHECKSUM IF (ERROR) GOTO 900 RETURN C C ERROR CONDITIONS C 900 TYPE 1000 1000 FORMAT('+?OUTPUT ERROR?',/) RETURN END SUBROUTINE OUTBYT(B) C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C C FUNCTION: C OUTPUT A BYTE TO THE OBJECT FILE BEING CREATED. C LOGICAL*1 B C IF (OPTR.LE.512) GOTO 100 !IF THERE'S SPACE LEFT IN THIS BLOCK WRITE (2'OREC,END=200,ERR=300) OBUF !ELSE DUMP CURRENT BLOCK OPTR = 1 100 OBUF(OPTR) = B OPTR = OPTR + 1 RETURN C C END-OF-FILE REACHED ON OUTPUT C 200 TYPE 1000 !INFORM USER OF DISASTER 1000 FORMAT('+?OUTPUT FILE TOO SMALL?',/) STOP !CAN'T CONTINUE FROM THIS MESS C C ERROR OCCURRED ON OUTPUT C 300 ERROR = .TRUE. RETURN END SUBROUTINE NEXT C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C C FUNCTION: C FIND NEXT MODULE IN THE INPUT FILE, AND PUT ITS NAME INTO C MODNAM. C IF (BUFFUL.GT.0) GOTO 100 !IF MUST SKIP CURRENT BLOCK 50 IF (FBCODE.EQ.1) GOTO 200 !IF THIS IS A GSD BLOCK 100 IF (LSTMOD) CALL OUTBLK !ELSE OUTPUT THIS BLOCK CALL INBLK !AND GET A NEW ONE IF (ERROR.OR.EOF) GOTO 900 GOTO 50 C C HERE AFTER A GSD BLOCK FOUND C 200 IF (FBLEN.LT.8) GOTO 100 !IGNORE IF BLOCK EMPTY IF (FBBUF(6).NE..FALSE.) GOTO 100 !IF THIS ISN'T MODULE NAME MODNAM(1) = IFBBUF(1) !ELSE SET NEW MODULE NAME MODNAM(2) = IFBBUF(2) C C RETURN, REGARDLESS OF ERRORS C 900 RETURN END ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. C SUBROUTINE POINT C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C C FUNCTION: C POSITION AT MODULE WHOSE NAME IS GIVEN BY CONTENTS OF C ARRAY NAME2. C REAL*4 RNAM,MNAM !FOR EASIER COMPARISON COMMON /CS/ NAME1(2),VALUE1,NAME2(2),VALUE2,RELATV,WORD,CMDNMB LOGICAL*4 WORD EQUIVALENCE (NAME2,RNAM),(MODNAM,MNAM) C 100 IF (RNAM.EQ.MNAM) GOTO 900 !IF THIS IS THE ONE WE'RE LOOKING FOR BUFFUL = 1 !FORCE A NEW FB BLOCK CALL NEXT !ELSE FIND NEXT MODULE IF (ERROR) GOTO 900 !IF ERROR, JUST RETURN IF (.NOT.EOF) GOTO 100 !ELSE CONTINUE LOOKING TYPE 1000 !DIDN'T FIND NAMED MODULE 1000 FORMAT('+?MODULE NOT FOUND?',/) C C RETURN, REGARDLESS OF ERRORS C 900 RETURN END SUBROUTINE LIST C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL,PREVIREC,PREVIPTR EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) REAL*8 PNAME !ASCII NAME BUFFER C C FUNCTION: C LIST NAMES OF ALL OBJECT MODULES IN THIS FILE C IRECSAVE = PREVIREC !SAVE PREVIOUS POSITION IN FILE IPTRSAVE = PREVIPTR !FOR LATER REPOSITIONING IPTR = 513 !FORCE A NEW READ LSTMOD = 0 !DON'T COPY TO OUTPUT FILE DURING THIS PROCESS IREC = 1 !GET THE FIRST RECORD NEXT TIME PRINT 1000 1000 FORMAT('1OBJECT MODULES:',/) 100 BUFFUL = 1 !FORCE A NEW FB BLOCK TO BE READ CALL NEXT !POSITION AT NEXT MODULE IN FILE IF (ERROR.OR.EOF) GOTO 800 CALL R50ASC(6,MODNAM,PNAME) !CONVERT TO PRINTABLE PRINT 1010,PNAME 1010 FORMAT('+',A6,/) GOTO 100 C C 800 IREC = IRECSAVE !RESTORE THE RECORD NUMBER PREVIREC = IRECSAVE - 1 !COMPUTE THE RECORD TO READ IF (PREVIREC.NE.0) READ (1'PREVIREC) IBUF !IF NOT AT BEGINNING IPTR = IPTRSAVE !RESTORE THE BUFFER POSITION LSTMOD = -1 !ALLOW COPYING TO OUTPUT AGAIN EOF = .FALSE. !CLEAR ANY END-OF-FILE INDICATION CALL INBLK !GET THE FB BLOCK BACK IN CALL NEXT !AND POSITION AT THE NEXT MODULE CALL CLOSE(6) !DUMP THE LAST BUFFER RETURN END SUBROUTINE WRDBYT C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 IFBBUF(25),MODNAM(2) COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C LOGICAL WRD*1, WORD REAL*4 NAME,GLOBAL,ENAME1,ENAME2 COMMON /SECTBL/ SECMAX,NAME(5),LENGTH(5), 1PTR1(5) COMMON /CHGTBL/ CHGMAX,OFFSET(20),GLOBAL(20), 1VALUE(20),DISP(20),WRD(20),PTR2(20) COMMON /CS/ NAME1(2),VALUE1,NAME2(2),VALUE2,RELATV,WORD EQUIVALENCE (NAME1,ENAME1),(NAME2,ENAME2) C IF (SECMAX.EQ.0) GOTO 110 !IF THE TABLE IS CURRENTLY EMPTY DO 100 I=1,SECMAX IF (ENAME1.EQ.NAME(I)) GOTO 200 100 CONTINUE C C CREATE NEW CSECT ENTRY IN TABLE C 110 SECMAX = SECMAX + 1 IF (SECMAX.GT.5) GOTO 900 !IF TOO MANY CSECTS HAVE BEEN USED NAME(SECMAX) = ENAME1 LEN = VALUE1 + 1 IF (WORD) LEN = LEN + 1 LENGTH(SECMAX) = LEN PTR1(SECMAX) = 0 I = SECMAX C C CREATE A NEW CHANGE ENTRY C 200 CHGMAX = CHGMAX + 1 IF (CHGMAX.GT.20) GOTO 910 !IF TOO MANY CHANGES OFFSET(CHGMAX) = VALUE1 LEN = VALUE1 + 1 IF (WORD) LEN = LEN + 1 IF (LENGTH(I).LT.LEN) LENGTH(I) = LEN GLOBAL(CHGMAX) = ENAME2 VALUE(CHGMAX) = VALUE2 DISP(CHGMAX) = RELATV !DISPLACED OR ABSOLUTE WRD(CHGMAX) = WORD PTR2(CHGMAX) = PTR1(I) PTR1(I) = CHGMAX RETURN C C 900 TYPE 901 901 FORMAT('+?MORE THAN 5 CSECTS REQUIRE CHANGE?',/) GOTO 999 910 TYPE 911 911 FORMAT('+?MORE THAN 20 CHANGES?',/) 999 ERROR = .TRUE. RETURN END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. C SUBROUTINE CLOSEF C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 IFBBUF(25),MODNAM(2) REAL*4 EFBBUF(12) COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD,BUFFUL EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C LOGICAL WRD*1, WORD REAL*4 NAME,GLOBAL,ENAME1,ENAME2,RLDNAM COMMON /SECTBL/ SECMAX,NAME(5),LENGTH(5), 1PTR1(5) COMMON /CHGTBL/ CHGMAX,OFFSET(20),GLOBAL(20), 1VALUE(20),DISP(20),WRD(20),PTR2(20) COMMON /CS/ NAME1(2),VALUE1,NAME2(2),VALUE2,RELATV,WORD EQUIVALENCE (NAME1,ENAME1),(NAME2,ENAME2),(EFBBUF,IFBBUF) EQUIVALENCE (RLDNAM,IFBBUF(2)) DIMENSION RELOC(8,2) DATA RELOC/3,1,4,2,3,1,6,5,4,4,6,6,4,4,8,8/ C C IF (BUFFUL.EQ.0) RETURN !RETURN IF NOTHING IN THIS BUFFER 50 IF (EOF) RETURN !RETURN IF NOTHING LEFT TO DO GOTO (100,200,800,800,800,300),FBCODE TYPE 51 !ERROR - BAD FB BLOCK TYPE 51 FORMAT('+?BAD OBJ?',/) RETURN C C PROCESS A GSD BLOCK C 100 IF (SECMAX.EQ.0) GOTO 800 DO 180 I=1,FBLEN,8 IF (FBBUF(I+5).NE.1) GOTO 180 !LOOK FOR CSECTS ITMP = I/4 DO 140 J=1,SECMAX !LOOK UP IN CSECT TABLE IF (NAME(J).NE.EFBBUF(ITMP+1)) GOTO 140 ITMP = ITMP * 2 !FOUND, UPDATE LENGTH IF NECESSARY IF (IFBBUF(ITMP+4).LT.LENGTH(J)) IFBBUF(ITMP+4) = LENGTH(J) LENGTH(J) = 0 GOTO 180 140 CONTINUE 180 CONTINUE GOTO 800 C C PROCESS END GSD C 200 IF (SECMAX.EQ.0) GOTO 290 FBLEN = 0 !NUMBER OF GSD'S IN BLOCK FBCODE = 1 !PREPARE TO OUTPUT EXTRA GSD'S DO 280 I=1,SECMAX !CHECK FOR ANY NEW CSECT NAMES IF (LENGTH(I).EQ.0) GOTO 280 EFBBUF(FBLEN/4+1) = NAME(I) IFBBUF(FBLEN/2+4) = LENGTH(I) FBBUF(FBLEN+5) = "100 + "40 + "10 !FLAGS = GLOBAL+RELOC+DEFINED FBBUF(FBLEN+6) = 1 !TYPE = CSECT FBLEN = FBLEN + 8 IF (FBLEN.LT.40) GOTO 280 CALL OUTBLK FBLEN = 0 280 CONTINUE IF (FBLEN.NE.0) CALL OUTBLK 290 FBLEN = 0 FBCODE = 2 !ENDGSD GOTO 800 C C PROCESS END OF OBJECT MODULE C 300 IF (SECMAX.EQ.0) GOTO 390 !ANYTHING TO DO? DO 380 I=1,SECMAX FBLEN = 8 FBCODE = 4 !RLD IFBBUF(1) = 7 !LOCATION COUNTER DEFINITION RLDNAM = NAME(I) !CSECT NAME IFBBUF(4) = 0 CALL OUTBLK P = PTR1(I) !POINT TO CHANGE LIST 310 IF (P.EQ.0) GOTO 380 !BEGIN LOOPING THROUUGH CHANGES FBLEN = 4 FBCODE = 4 !RLD IFBBUF(1) = "10 !LOCATION COUNTER MODIFICATION IFBBUF(2) = OFFSET(P) !TO LOC OF NEXT CHANGE CALL OUTBLK FBLEN = 4 FBCODE = 3 !TXT IFBBUF(1) = OFFSET(P) !LOAD ADDRESS IFBBUF(2) = VALUE(P) !CONTENTS IF (.NOT.WRD(P)) FBLEN = FBLEN - 1 !IF BYTE PATCH CALL OUTBLK ITMP = 1 IF (DISP(P)) 315,370,320 !DISPLACED OR RELOCATABLE 315 ITMP = ITMP + 1 !INDICATED RELOCATABLE 320 IF (GLOBAL(P).NE.0.0) ITMP = ITMP + 2 IF (VALUE(P).NE.0) ITMP = ITMP + 4 FBCODE = 4 !RLD FBLEN = RELOC(ITMP,2) !RLD LENGTH FOR THIS RELOC IFBBUF(1) = RELOC(ITMP,1) + 4*256 !RELOC. CODE TO MODIFY PREV TXT IF (.NOT.WRD(P)) IFBBUF(1) = IFBBUF(1) + "200 !MAKE BYTE CMD ITMP = 2 IF (GLOBAL(P).EQ.0.0) GOTO 330 RLDNAM = GLOBAL(P) ITMP = 4 IF (VALUE(P).EQ.0) GOTO 340 330 IFBBUF(ITMP) = VALUE(P) 340 CALL OUTBLK 370 P = PTR2(P) !LINK TO NEXT CHANGE IF ANY GOTO 310 380 CONTINUE 390 SECMAX = 0 CHGMAX = 0 FBLEN = 0 FBCODE = 6 !END OF MODULE CALL NEXT RETURN 800 CALL OUTBLK CALL INBLK IF (.NOT.ERROR) GOTO 50 TYPE 1000 1000 FORMAT('+?BAD OBJ?',/) END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C RT-11 OBJECT MODULE PATCH UTILITY (PATCHO) C C DEC-11-ORPOA-E C C ECP, RRB, BAM C APRIL 1974 C BC SEP 1975 C C COPYRIGHT (C) 1974,1975 C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY C ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH C THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, C OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE C AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO C ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE C SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO C CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED C AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. C C DEC ASSUMES NO RESPONSIBILITY FOR THE USE C OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT C WHICH IS NOT SUPPLIED BY DEC. SUBROUTINE DUMP C IMPLICIT INTEGER*2 (A-Z) LOGICAL*1 IBUF(512),OBUF(512),FBBUF(50),B1(2),B2(2),ERROR,EOF INTEGER*2 FBLEN,FBPTR,FBCODE,IFBBUF(25),IPTR,OPTR, 1MODNAM(2),LSTMOD COMMON FBBUF,FBLEN,FBPTR,FBCODE,IBUF,OBUF,IPTR,OPTR,ERROR,EOF, 1IREC,OREC,MODNAM,LSTMOD EQUIVALENCE (FBBUF,IFBBUF),(B1,FBLEN),(B2,FBCODE) C REAL*4 ANS !STMT FUNCTION FOR GSD PRINTER ANS(MASK) = YESNO(((FBBUF(I+4).AND.MASK).NE.0)+2) REAL*4 YESNO(2) !FOR GSD DATA YESNO/'YES','NO'/ REAL*8 GLBNAM(5) !TYPES OF GSD ENTRIES DATA GLBNAM/'MOD NAME','CSECT','INTERNAL','TRAN ADR','GLOBAL'/ INTEGER*2 LOADADRS !LOAD ADDRESS OF LAST TEXT BLOCK SEEN REAL*8 PNAME !RAD50 WORKAREA DATA PNAME/' '/ REAL*8 BLOCKNAMES(6) !NAMES FOR VARIOUS BLOCK TYPES DATA BLOCKNAMES/'GSD','GSD END','TXT','RLD','ISD','MOD END'/ REAL*8 RLDNAMES(9) !NAMES OF VARIOUS RELOCATION TYPES DATA RLDNAMES/'INTERNAL','GLOBAL','INT DISP','GLB DISP','GLB ADD', 1 'GL AD DS','LCTR DEF','LCTR MOD','LIMITS'/ LOGICAL*1 RLDOCT(9),RLDR50(9) DATA RLDOCT/F,T,F,T,F,F,F,F,T/ DATA RLDR50/T,F,T,F,F,F,F,T,T/ C C FUNCTION: C DUMP THE NEXT OBJECT MODULE IN THE FILE. C CALL R50ASC(6,MODNAM,PNAME) !PREPARE NAME OF MODULE FOR PRINTING PRINT 1110,PNAME 1110 FORMAT('1DUMP OF MODULE ',A6,/,22('-')) GOTO 60 !SKIP THE READ ON ENTRY (ALREADY AT A GSD) 50 CALL OUTBLK !DUMP THE CURRENT BLOCK CALL INBLK !GET THE NEXT FB BLOCK IN BUFFER IF (ERROR) GOTO 900 !IF PROBLEMS IN INBLK IF (EOF) GOTO 610 !DONE - JUST DUMP LAST BUFFER 60 IF (FBCODE.LT.1) GOTO 900 !CHECK FOR BAD FB BLOCK TYPE IF (FBCODE.GT.6) GOTO 900 PRINT 1000,BLOCKNAMES(FBCODE) 1000 FORMAT(/1X,'BLOCK TYPE ',A8,/) GOTO (100,50,300,400,50,600),FBCODE !DISPATCH TO ROUTINE C C GSD C 100 PRINT 1010 !PRINT GSD HEADER 1010 FORMAT('+GLOBAL',T10,'USAGE',T20,'DEFINED',T30,'RELOC', 1T40,'EXTERNAL',T50,'SIZE/ADRS') DO 110 I=1,FBLEN,8 !FOR EACH ENTRY IN THE GSD BLOCK CALL R50ASC(6,FBBUF(I),PNAME) PRINT 1011,PNAME,GLBNAM(FBBUF(I+5)+1),ANS("10),ANS("40),ANS("100), 1IFBBUF(I/2+4) 1011 FORMAT(1X,A8,A8,A7,A9,A11,O13) 110 CONTINUE GOTO 50 C C GSD END (IGNORED) C C C TXT C 300 FBBUF(FBLEN+1) = .FALSE. !MAKE SURE LAST BYTE IS ZERO LOADADRS = IFBBUF(1) !SAVE LOAD ADDRESS OF BLOCK PRINT 1020,(IFBBUF(1)+I-1,IFBBUF(I/2+2),(FBBUF(I+2).AND."377), 1(FBBUF(I+3).AND."377), I=1,FBLEN-2,2) 1020 FORMAT('+ADDRESS',T10,'CONTENTS'/(1X,O7,O9,O6,O4)) GOTO 50 C C RLD C 400 I=1 !INITIALIZE POINTER PRINT 1030 1030 FORMAT('+ADDRESS',T10,'RLD TYPE',T20,'GLOBAL',T30,'OFFSET'/) 410 IF (I.GT.FBLEN) GOTO 50 ICODE = FBBUF(I) .AND. "177 !STRIP OFF BYTE OP FLAG BIT IF (ICODE.GT."11) ICODE = ICODE - "10 !FIX MACRO BUG PRINT 1050, LOADADRS-4+FBBUF(I+1), RLDNAMES(ICODE) !RELOC TYPE 1050 FORMAT(O7,A10) IF (FBBUF(I).AND."200) PRINT 1060 !NOTE IF BYTE OPERATION 1060 FORMAT(1H+,T18,'*') I = I + 2 !SKIP COMMAND BYTE AND OFFSET IF (RLDR50(ICODE)) GOTO 420 !IF NO GLOBAL SYMBOL NAME CALL R50ASC(6,FBBUF(I),PNAME) !ELSE CONVERT IT TO ASCII PRINT 1070,PNAME !AND PRINT IT 1070 FORMAT(1H+,T20,A8) I = I + 4 !SKIP TWO WORDS OF RAD50 420 IF (RLDOCT(ICODE)) GOTO 410 !IF NO OCTAL OFFSET TO PRINT PRINT 1080, IFBBUF(I/2+1) !PRINT IT 1080 FORMAT(1H+,T30,O6) I = I + 2 !SKIP THE WORD JUST PRINTED GOTO 410 !GO PROCESS ANY ENTRIES REMAINING IN THIS BLOCK C C ISD (IGNORED) C C C MODULE END C 600 CALL NEXT !POSITION AT NEXT MODULE IN FILE 610 CALL CLOSE(6) !DUMP THE LAST BUFFER RETURN !RETURN TO COMMAND DECODER C C ERROR CONDITIONS C 900 TYPE 1100 !INDICATE ERROR CONDITION 1100 FORMAT('+?DUMP ERROR?',/) RETURN END ������������������������; RT-11 FORTRAN SYSTEM SUBROUTINE LIBRARY ; DEC-11-ORLBA-E-LA ; ; ; ; ; ; ; ; ; ; ; COPYRIGHT (C) 1975 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS ; ; ; ; ; ; ; ; ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS ; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO- ; VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON ; EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO ; THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A ; COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; ; ; ; ; ; ; ; ; ; ; ; ; .TITLE IRAD50, RAD50 ; R. BILLIG ; REGISTER DEFINITIONS R0= %0 R1= %1 R2= %2 R3= %3 R4= %4 R5= %5 SP= %6 PC= %7 ; FORMAT OF FORTRAN CALLS: ; ; N = IRAD50( ICNT, INPUT, OUTPUT ) ; ; N= NUMBER OF CHARACTERS ACTUALLY CONVERTED ; ICNT= MAXIMUM NUMBER OF CHARACTERS TO BE CONVERTED ; INPUT= ENTITY FROM WHICH INPUT ASCII CHARACTERS ARE TAKEN ; OUTPUT= ENTITY INTO WHICH RAD50 WORDS ARE STORED ; ; NOTE: EXACTLY (ICNT + 2) / 3 WORDS ARE PRODUCED ; CONVERSION STOPS ON THE FIRST NON-RAD50 CHARACTER FOUND ; ; A = RAD50( INPUT ) ; ; A= REAL*4 ENTITY WHICH RECEIVES TWO-WORD RAD50 RESULT ; INPUT= ENTITY FORM WHICH ASCII CHARACTERS ARE TAKEN ; ; NOTE: RAD50 CONVERTS A MAXIMUM OF 6 INPUT CHARACTERS ; TWO WORDS OF RAD50 ARE ALWAYS PRODUCED ; ; A = RAD50(LINE) IS EXACTLY EQUIVALENT TO: ; CALL IRAD50(6,LINE,A) .GLOBL $SYSLB ;VERSION NUMBER REF .GLOBL IRAD50 IRAD50: TST (R5)+ ;DISCARD # OF ARGUMENTS MOV @(R5)+,R0 ;R0 = MAX # OF CHARACTERS TO CONVERT MOV (R5)+,R4 ;R4 -> INPUT MOV @R5,R2 ;R2 -> OUTPUT MOV R0,R5 ;R5 = MAX CHARACTERS CLR R3 ;R3 = # OF CHARS ACTUALLY CONVERTED 1$: MOV R2,-(SP) ;SAVE OUTPUT POINTER JSR PC,R50WRD ;GO CONVERT A WORD MOV (SP)+,R2 ;RETRIEVE OUTPUT POINTER MOV R1,(R2)+ ;STORE CONVERTED CHARS TST R5 ;DONE YET? BGT 1$ ;NOPE MOV R3,R0 ;RETURN # CHARS CONVERTED RTS PC ;RETURN TO CALLER .GLOBL RAD50 RAD50: TST (R5)+ ;DISCARD # OF ARGUMENTS MOV (R5)+,R4 ;R4 -> INPUT MOV #6,R5 ;R5 = MAX CHARS TO CONVERT JSR PC,R50WRD ;CONVERT FIRST WORD MOV R1,-(SP) ;SAVE IT JSR PC,R50WRD ;CONVERT SECOND WORD MOV (SP)+,R0 ;SET UP R0,R1 REAL*4 VALUE RETURN RTS PC ;AND RETURN TO CALLER .SBTTL COMMON RAD50 CONVERSION ROUTINE ; REGISTER USAGE NOTES: ; ; R0 WORK REGISTER ; R1 RAD50 VALUE TO BE RETURNED ; R2 WORK REGISTER ; R3 NUMBER OF CHARACTERS CONVERTED SO FAR ; R4 ADRS OF NEXT INPUT CHARACTER ; R5 MAXIMUM NUMBER OF INPUT CHARACTERS LEFT R50WRD: MOV #2,-(SP) ;SET LOOP COUNT (3 CHARS/WORD) CLR R1 ;ZERO ACCUMULATOR WORD 1$: CLR R0 ;ZERO CURRENT RAD50 CHAR DEC R5 ;ANY CHARS LEFT TO PROCESS BMI 5$ ;NO MORE CHARS TO PROCESS MOV #R50TAB,R2 ;GET CONVERSION TABLE POINTER BISB (R4)+,R0 ;GET NEXT INPUT CHAR 2$: CMPB (R2)+,R0 ;.LE. UPPER LIMIT? BLO 3$ ;NOPE - NOT IN THIS RANGE CMPB (R2)+,R0 ;.GT. LOWER LIMIT? BLO 4$ ;YES - FOUND CONVERSION (AND SET CARRY) DEC R2 ;ELSE BUMP OVER REMAINDER 3$: ADD #3,R2 ; OF TABLE ENTRY TST @R2 ;END OF TABLE REACHED? BNE 2$ ;NOPE - CONTINUE LOOKING NEG R5 ;ELSE INDICATE NON-RAD50 CHAR FOUND CLR R0 ;MAKE CURRENT = 0 (AND CLEAR C) 4$: ADC R3 ;UPDATE CHARACTER COUNT ADD @R2,R0 ;DO TRANSLATION 5$: ASL R1 ;MULTIPLY PREVIOUS BY 50(8) ASL R1 ASL R1 ADD R1,R0 ASL R1 ASL R1 ADD R0,R1 ;AND ADD IN CURRENT CHAR DEC @SP ;ANY CHARS LEFT IN THIS WORD? BPL 1$ ;YES TST (SP)+ ;ELSE DISCARD LOOP COUNT RTS PC ;AND RETURN R50TAB: .BYTE 132,100 ;A-Z .WORD -100 .BYTE 71,57 ;0-9 .WORD -22 .BYTE 40,37 ;SPACE .WORD -40 .BYTE 44,43 ;DOLLAR SIGN .WORD -11 .BYTE 56,55 ;PERIOD .WORD -22 .WORD 0 ;END OF TABLE FLAG (MUST BE ZERO) .END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������; RT-11 FORTRAN SYSTEM SUBROUTINE LIBRARY ; DEC-11-ORLBA-E-LA ; ; ; ; ; ; ; ; ; ; ; COPYRIGHT (C) 1975 BY DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSSETTS ; ; ; ; ; ; ; ; ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS ; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO- ; VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON ; EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO ; THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE ; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A ; COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY ; FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; ; ; ; ; ; ; ; ; ; ; ; ; .TITLE R50ASC ; R. BILLIG ; REGISTER DEFINITIONS R0= %0 R1= %1 R2= %2 R3= %3 R4= %4 R5= %5 SP= %6 PC= %7 ; FORMAT OF FORTRAN CALL: ; ; CALL R50ASC( ICNT, INPUT, OUTPUT ) ; ; ICNT= MAXIMUM NUMBER OF CHARACTERS TO BE OUTPUT ; INPUT= ENTITY FROM WHICH RAD50 INPUT WORDS ARE TO BE TAKEN ; OUTPUT= ENTITY INTO WHICH ASCII OUTPUT IS TO BE PLACED .GLOBL $SYSLB ;VERSION NUMBER REF .GLOBL R50ASC R50ASC: TST (R5)+ ;DISCARD NUMBER OF ARGUMENTS MOV @(R5)+,R1 ;R1 = # OF CHARS TO OUTPUT MOV (R5)+,R4 ;R4 -> INPUT WORDS MOV @R5,R5 ;R5 -> OUTPUT AREA 1$: MOV #DIVTAB,R3 ;R3 -> DIVISION TABLE MOV (R4)+,R2 ;R2 = CURRENT INPUT WORD 2$: TST -(R3) ;NEW WORD REQUIRED YET? BEQ 1$ ;YES MOV #-1,R0 ;INITIALIZE QUOTIENT REG CMP #174777,R2 ;RAD50 VALUE TOO LARGE? BLO 4$ ;YES - OUTPUT QUESTION MARKS 3$: INC R0 ;DIVIDE BY APPROPRIATE POWER OF 50(8) SUB @R3,R2 BCC 3$ ADD @R3,R2 ;RESTORE DIVIDEND TST R0 ;CHARACTER IS A BLANK? BEQ 5$ ;YES CMP #33,R0 ;DOLLAR SIGN, PERIOD, OR DIGIT? BLO 6$ ;PERIOD OR DIGIT BEQ 7$ ;DOLLAR SIGN 4$: ADD #40,R0 ;ELSE ALPHA (A-Z) OR QUESTION MARK (SEE ABOVE) 5$: ADD #16,R0 6$: ADD #11,R0 7$: ADD #11,R0 8$: MOVB R0,(R5)+ ;STORE CONVERTED CHARACTER IN OUTPUT DEC R1 ;ANY MORE CHARS TO PRODUCE? BNE 2$ ;YES RTS PC .WORD 0 ;END-OF-TABLE FLAG .WORD 1 .WORD 50 .WORD 3100 DIVTAB= . ;RAD50 DIVISION TABLE .END �������������������������������������������������������������������������������������������; MACRO3.MAC V02-12 .NLIST ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; .LIST .SBTTL RSX11D "FEATURES" .IF DF RSX11D ; THE MACRO "GENREG" IS USED TO SPECIFY A REGISTER ROLL SYMBOL. ; ENTSEC REGSEC REGBAS: .MACRO GENREG RNAME,VALUE ENTSEC REGSEC .RAD50 /RNAME/ .WORD 0 .BYTE DEFFLG+REGFLG,0 .WORD VALUE XITSEC .ENDM GENREG R0,0 GENREG R1,1 GENREG R2,2 GENREG R3,3 GENREG R4,4 GENREG R5,5 GENREG SP,6 GENREG PC,7 ENTSEC REGSEC REGTOP: XITSEC .TITLE MACRO ; THE MACRO "GENSAT" IS USED TO GENERATE A SECTION ATTRIBUTE ROLL ENTRY. ; ENTSEC SATSEC SATBAS: .MACRO GENSAT SAT,FLG,TYP ENTSEC SATSEC .RAD50 /SAT/ .BYTE FLG,TYP XITSEC .ENDM GENSAT ABS,CSTREL,1 GENSAT CON,CSTALO,1 GENSAT D,CSTTYP,-1 GENSAT GBL,CSTGBL,-1 GENSAT HGH,CSTMEM,-1 GENSAT I,CSTTYP,1 GENSAT LCL,CSTGBL,1 GENSAT LOW,CSTMEM,1 GENSAT OVR,CSTALO,-1 GENSAT REL,CSTREL,-1 GENSAT RO,CSTACC,-1 GENSAT RW,CSTACC,1 ENTSEC SATSEC SATTOP: XITSEC DFGFLG= 000020 ;DEFAULTED GLOBAL REFERENCE ;**-4 ; CONTROL SECTION ATTRIBUTE FLAGS ; CSTACC=000020 ;ACCESS (1=RO, 0=RW) CSTALO=000004 ;ALLOCATION (1=OVR, 0=CON) CSTGBL=000100 ;SCOPE (1=GLOBAL, 0=LOCAL) CSTREL=000040 ;RELOCATION (1=REL, 0=ABS) CSTTYP=000200 ;TYPE (1=DATA, 0=INSTRUCTION) CSTMEM=000001 ;MEMORY SPEED (1=HIGH, 0=LOW) ; ; DEFAULT SECTION FLAGS ; ASTFLG=CSTALO!CSTGBL!DEFFLG ;ABS SECTION CSTFLG=CSTREL!DEFFLG ;CSECT SECTION PSTFLG=CSTFLG ;PSECT SECTION ;**NEW** ;**-1 .ENDC ENTSEC EDTSEC EDTBAS: .MACRO GENEDT MNE,SUBR,INIT ENTSEC EDTSEC ED.'MNE= EDTTMP EDTTMP= EDTTMP+EDTTMP .GLOBL ED.'MNE .RAD50 /MNE/ .IF NB SUBR .WORD SUBR .IFF .WORD CPOPJ .ENDC XITSEC .IIF NB <INIT>, EDINIT= EDINIT!ED.'MNE .ENDM GENEDT EDTTMP= 1 .IIF NDF EDINIT, EDINIT= 0 XITSEC ;THE MACRO "GENCND" IS USED TO SPECIFY CONDITIONAL ;ARGUMENTS. IT TAKES TWO OR THREE ARGUMENTS: ; 1- MNEMONIC ; 2- SUBROUTINE TO BE CALLED ; 3- IF NON-BLANK, COMPLEMENT CONDITION ENTSEC CNDSEC CNDBAS: .MACRO GENCND MNE,SUBR,TOGGLE ;GENERATE CONDITIONAL ENTSEC CNDSEC .RAD50 /MNE/ .IF B <TOGGLE> .WORD SUBR .IFF .WORD SUBR+1 .ENDC XITSEC .ENDM ;THE FOLLOWING SECTOR IS USED TO COLLECT BYTE STRINGS ;AND NEEDN'T BE LEFT AT AN EVEN LOCATION ENTSEC TXTBYT XITSEC CH.IOR= '! CH.QTM= '" CH.HSH= '# CH.DOL= '$ CH.PCT= '% CH.AND= '& CH.XCL= '' CH.LP= '( CH.RP= ') CH.MUL= '* CH.ADD= '+ CH.COM= ', CH.SUB= '- CH.DOT= '. CH.DIV= '/ CH.COL= ': CH.SMC= '; CH.LAB= '< CH.EQU= '= CH.RAB= '> CH.QM= '? CH.IND= '@ CH.BSL= '\ CH.UAR= '^ LET.A= 'A LET.B= 'B LET.C= 'C LET.D= 'D LET.E= 'E LET.F= 'F LET.G= 'G LET.O= 'O LET.Z= 'Z DIG.0= '0 DIG.9= '9 GENCAL SAVREG ;SAVE REGISTERS GENCAL EXPR ;CALL THE EXPRESSION EVALUATOR GENCAL TERM GENCAL RELEXP GENCAL RELTST GENCAL ABSEXP GENCAL ABSTST GENCAL ABSERR GENCAL GLBEXP GENCAL ABSTRM ;ABSOLUTE TERM GENCAL RELTRM ;RELOCATABLE TERM GENCAL GLBTRM ;GLOBAL TERM GENCAL GETSYM GENCAL SETSYM GENCAL GETR50 GENCAL SETR50 GENCAL TSTR50 GENCAL GETNB GENCAL SETNB GENCAL GETCHR GENCAL SETCHR GENCAL GSARG GENCAL TSTARG GENCAL SETIMM GENCAL SETDSP GENCAL STCODE GENCAL SSRCH GENCAL OSRCH .IIF NDF XMACRO, GENCAL MSRCH .IIF NDF XEDLSB, GENCAL LSRCH GENCAL SETPF0 GENCAL SETPF1 GENCAL DNC GENCAL CVTNUM GENCAL R50UNP GENCAL MOVBYT .SBTTL MISCELLANEOUS MACRO DEFINITIONS GENCAL SETXPR .IF NDF PDPV45 .MACRO MUL SRC,DST .IIF DIF <SRC>,<R3>, MOV SRC,R3 .IIF DIF <DST>,<R0>, .ERROR ;ILLEGAL MUL ARGS CALL MUL .ENDM .MACRO DIV SRC,DST .IIF DIF <SRC>,<R3>, MOV SRC,R3 .IIF DIF <DST>,<R0>, .ERROR ;ILLEGAL DIV ARGS CALL DIV .ENDM .MACRO SOB REG,ADDR DEC REG BNE ADDR .ENDM .ENDC .IF NDF XCREF GENCAL CRFREF ;CROSS REFERENCE A SYMBOL GENCAL CRFDEF ;DITTO, DEFINING IT .IFF .MACRO CRFREF ;DUMMY IF NO CREF .ENDM .MACRO CRFDEF .ENDM .ENDC .MACRO CHSCAN TABLE ;CHARACTER SCAN MOV #TABLE,R0 CALL CHSCAN .ENDM .MACRO GCHTBL CHAR, ADDR ;GEN CHARACTER SCAN TABLE .WORD ADDR, CHAR .ENDM ; ERROR FLAG DEFINITIONS ENTSEC TXTBYT TMPCNT= 1 ;SET FOR BIT SHIFTING ERRMNE: .IRPC CHAR,< ABDEILMNOPQRTUZ> .ASCII /CHAR/ ERR.'CHAR= TMPCNT TMPCNT= TMPCNT+TMPCNT .ENDM .MACRO ERROR ARG BIS #ERR.'ARG,ERRBTS .ENDM .MACRO SETNZ ADDR ;SET ADDR TO NON-ZERO FOR T/F FLAGS MOV SP,ADDR .ENDM .SBTTL ROLL DEFINITIONS ENTSEC ROLBAS ROLBAS: ENTSEC ROLTOP ROLTOP: ENTSEC ROLSIZ ROLSIZ: XITSEC .MACRO GENROL NAME, BASE, TOP, SIZE ENTSEC ROLBAS NAME'ROL= .-ROLBAS .WORD BASE ENTSEC ROLTOP .WORD TOP ENTSEC ROLSIZ .WORD SIZE*2 XITSEC RS.'NAME= SIZE .IIF GT SIZE-MAXXMT, MAXXMT=SIZE .ENDM GENROL .IIF NDF MAXXMT, MAXXMT= 0 GENROL SYM, 0, 0,4 ;SYMBOL TABLE .IF NDF XMACRO GENROL MAC, 0, 0,4 ;MACRO ROLL GENROL DMA, 0, 0,2 ;DUMMY ARGUMENT ROLL .ENDC .IF NDF XEDLSB GENROL LSY, 0, 0,4 ;LOCAL SYMBOL ROLL .ENDC GENROL SEC, 0, 0,5 ;SECTION ROLL GENROL COD, 0, 0,4 ;CODE ROLL .IF NDF XMACRO GENROL MAB, 0, 0,BPMB/2 GENROL MAA, 0, 0,BPMB/2 .ENDC GENROL DUM, 0, 0,0 ;DUMMY (SEPARATES VARIABLE FROM FIXED) GENROL CND,CNDBAS,CNDTOP,2 ;CONDITIONAL ARGUMENTS GENROL SWT,SWTBAS,SWTTOP,2 ;COMMAND STRING SWITCHES GENROL EDT,EDTBAS,EDTTOP,2 ;ENABL/DSABL GENROL LCD,LCTBAS,LCTTOP,1 ;LISTING CONTROL GENROL PST,PSTBAS,PSTTOP,4 ;PERMANENT SYMBOL TABLE .IF DF RSX11D GENROL REG,REGBAS,REGTOP,4 GENROL SAT,SATBAS,SATTOP,2 .ENDC ;ROLL HANDLER CALLS .MACRO SEARCH ROLNUM ;BINARY SEARCH MOV #ROLNUM,R0 CALL SEARCH .ENDM .MACRO SCAN ROLNUM ;LINEAR SCAN MOV #ROLNUM,R0 CALL SCAN .ENDM .MACRO SCANW ROLNUM ;LINEAR SCAN, ONE WORD MOV #ROLNUM,R0 CALL SCANW .ENDM .MACRO NEXT ROLNUM ;FETCH NEXT ENTRY MOV #ROLNUM,R0 CALL NEXT .ENDM .MACRO APPEND ROLNUM ;APPEND TO END OF ROLL MOV #ROLNUM,R0 CALL APPEND .ENDM .MACRO ZAP ROLNUM ;CLEAR ROLL MOV #ROLNUM,R0 CALL ZAP .ENDM GENCAL INSERT ;INSERT (MUST BE PRECEDED BY ONE ;OF THE ABOVE TO SET POINTERS) GENCAL SETROL ;SAVE AND SET REGS FOR ABOVE ENTSEC XCTPRG ;PROGRAM INITIALIZATION CODE XCTPRG: MOV #IMPURE,R0 1$: CLR (R0)+ ;CLEAR IMPURE AREA CMP #IMPURT,R0 BHI 1$ ENTSEC XCTPAS ;PASS INITIALIZATION CODE XCTPAS: MOV #IMPPAS,R0 2$: CLR (R0)+ ;CLEAR IMPURE PART CMP #IMPPAT,R0 BHI 2$ ENTSEC XCTLIN ;LINE INITIALIZATION CODE XCTLIN: MOV #IMPLIN,R0 3$: CLR (R0)+ CMP #IMPLIT,R0 BHI 3$ ENTSEC IMPURE IMPURE: ENTSEC IMPPAS IMPPAS: ENTSEC IMPLIN IMPLIN: XITSEC .SBTTL ASSEMBLER PROPER .SBTTL OBJECT FILE .IF NDF XREL RLDT00= 00 ; ABSOLUTE DATA RLDT01= 01 ; INTERNAL RELOCATION TST #C RLDT02= 02 ; GLOBAL RELOCATION TST #G RLDT03= 03 ; INTERNAL DISPLACED RELOCATION TST ABS RLDT04= 04 ; GLOBAL DISPLACED RELOCATION TST X RLDT05= 05 ; GLOBAL ADDITIVE RELOCATION TST #X+6 RLDT06= 06 ; GLOBAL ADDITIVE DISPLACED RELOCATION TST #X+6 RLDT07= 07 ; NEW CSECT RLDT10= 10 ; SEQUENCE BREAK RLDT11= 11 ; LIMIT RLDT15= 15 ; SECTOR ADDITIVE RELOCATION TST #O RLDT16= 16 ; SECTOR ADDITIVE DISPLACED RELOCATION TST #O+6 GSDT00= 00*400 ; OBJECT MODULE NAME GSDT01= 01*400 ; PROGRAM SECTION NAME GSDT02= 02*400 ; INTERNAL SYMBOL TABLE GSDT03= 03*400 ; TRANSFER ADDRESS GSDT04= 04*400 ; SYMBOL DECLARATION GSDT05= 05*400 ; LOCAL SECTION NAME GSDT06= 06*400 ; VERSION IDENTIFICATION BLKT01= 01 ; GSD BLKT02= 02 ; GSD END BLKT03= 03 ; TEXT BLOCK BLKT04= 04 ; RLD BLOCK BLKT05= 05 ; ISD BLKT06= 06 ; MODULE END .ENDC ;FLAGS USED IN SYMBOL TABLE MODE DEFFLG= 000010 ;DEFINED RELFLG= 000040 ;RELOCATABLE GLBFLG= 000100 ;GLOBAL REGFLG= 000001 ;REGISTER LBLFLG= 000002 ;LABEL MDFFLG= 000004 ;MULTILPY DEFINED ;ADDRESS MODE FLAGS AM.DEF= 10 ;DEFERRED MODE AM.INC= 20 ;AUTO-INCREMENT MODE AM.DEC= 40 ;AUTO-DECREMENT MODE AM.NDX= 60 ;INDEX MODE AM.PC= 07 ;PC MODE ADDRESSING AM.IMM= AM.INC+AM.PC ;IMMEDIATE MODE AM.REL= AM.NDX+AM.PC ;RELATIVE MODE ;DIRECTIVE FLAGS DEFINED IN PST .GLOBL DFLCND, DFLMAC, DFLGEV .GLOBL DFLGBM, DFLSMC .GLOBL PSTBAS, PSTTOP, WRDSYM .MACRO IMULI COUNT,ADDR .LIST MEB T.VAL= COUNT .IF EQ T.VAL CLR ADDR .IFF .IF LT T.VAL T.VAL= -T.VAL NEG ADDR .ENDC T.FLAG= 0 T.MASK= 040000 .REPT ^D14 .IF LE T.MASK-T.VAL .IF NE T.MASK&T.VAL .IF NE T.MASK-T.VAL .IF EQ T.FLAG MOV ADDR,-(SP) T.FLAG= 1 .IFF .IF NE T.MASK-1&T.VAL ADD (SP),ADDR .IFF ADD (SP)+,ADDR T.FLAG= 0 .ENDC .ENDC .ENDC .ENDC ASL ADDR .ENDC T.MASK= T.MASK/2 .ENDR .IF NE T.FLAG ADD (SP)+,ADDR .ENDC .ENDC .NLIST MEB .ENDM ENTSEC IMPURE PASS: .BLKW ;NEXT GROUP MUST STAY TOGETHER ENTSEC IMPPAS SYMBOL: .BLKW 2 ;SYMBOL ACCUMULATOR MODE: FLAGS: .BLKB 1 ;FLAG BITS SECTOR: .BLKB 1 ;SYMBOL/EXPRESSION TYPE VALUE: .BLKW 1 ;EXPRESSION VALUE RELLVL: .BLKW 1 .REPT MAXXMT-<<.-SYMBOL>/2> ;END OF GROUPED DATA .BLKW .ENDR CLCNAM: .BLKW 2 ;CURRENT LOCATION COUNTER SYMBOL CLCFGS: .BLKB 1 CLCSEC: .BLKB 1 CLCLOC: .BLKW 1 CLCMAX: .BLKW 1 CHRPNT: .BLKW ;CHARACTER POINTER SYMBEG: .BLKW ;POINTER TO START OF SYMBOL ENDFLG: .BLKW XITSEC ;RETURN TO NORMAL ASSEM: ;SET SYMBOL TABLES CALL XCTPRG ;CLEAR CORE .IF NDF XMACRO BIC #BPMB-1,SYTTOP ;MACRO STORAGE MUST BE MODULO .ENDC MOV #DUMROL,R1 ;POINT TO SEPARATOR ROLL 1$: MOV SYTTOP,ROLBAS(R1) ;SET BASE MOV SYTTOP,ROLTOP(R1) ; AND TOP CLRB ROLSIZ+1(R1) ;ZERO CURRENT SIZE SUB #2,R1 ;MOVE DOWN A ROLL BGE 1$ ;LOOP 'TILL ROLL #0 RETURN MACP1: ;MACRO PASS 1 CALL XCTPAS MOV #LST.KB*400,R0 ;SET ERROR SLOT TSTB IOFTBL+LSTCHN ;LISTING DEVICE? BEQ 1$ ; NO BIS #LST.KB!100200,R0 ;YES, ASSUME TELETYPE BIT #IO.TTY,IOFTBL+LSTCHN ;TRUE? BNE 1$ ; YES ADD #<LST.LP-LST.KB>*401,R0 ;NO, UPGRADE TO LP 1$: MOV R0,LSTDEV ;SET FLAGS CALL SETHDR ;SET UP HEADER BR MACP2F MACP2: ;MACRO PASS 2 CALL XCTPAS MACP2F: CALL SECINI ;INIT THE SECTOR ROLL 3$: CALL GETLIN ;GET THE NEXT INPUT LINE BNE 4$ ; BRANCH IF EOF CALL STMNT ;PROCESS THE STATEMENT 4$: CALL ENDLIN ;POLISH OFF LINE TST ENDFLG ;END SEEN? BEQ 3$ ; NO, CONTINUE RETURN ENTSEC DPURE R50ABS: .RAD50 /. ABS./ R50DOT: .RAD50 /. / XITSEC GETLIN: ;GET AN INPUT LINE SAVREG GETL01: CALL XCTLIN ;INIT LINE-ORIENTED VARIABLES MOV FFCNT,R0 ;ANY RESERVED FF'S? BEQ 31$ ; NO ADD R0,PAGNUM ;YES, UPDATE PAGE NUMBER MOV #-1,PAGEXT CLR FFCNT .IF NDF XLCSEQ CLR LINNUM ;INIT NEW CREF SEQUENCE CLR SEQEND .ENDC TST PASS BEQ 31$ CLR LPPCNT 31$: MOV #LINBUF,R2 MOV R2,LCBEGL ;SEAT UP BEGINNING MOV #LINEND,LCENDL ; AND END OF LINE MARKERS CALL GETL20 ;GET PHYSICAL LINE TST R0 ;TEST RESULT BLT GETL01 ;RE-TRY IF .LT. 0 BGT GETL09 ;EXIT IF .GT. 0 ;FALL THROUGH IF .EQ. 0 GETL02: ADD R1,R4 ;COMPUTE END 3$: CLRB (R4) ;FORM ASCIZ MOVB -(R4),R5 ;GET LAST CHAR CMP R5,#CR ;IF > CR BHI 6$ CMP R5,#LF ; OR < LF BLO 6$ ; MOVE ON CMP R5,#FF ;FORM FEED? BNE 3$ ; NO, LOOP .IF NDF XSML TST SMLLVL ;SYSTEM MACRO? BNE 3$ ; YES, DON'T TALLY FF .ENDC INC FFCNT ;COUNT THE PAGE BR 3$ 5$: MOVB R5,(R2)+ ;MOVE INTO LINBUF 6$: MOVB (R1)+,R5 ;FETCH NEXT CHAR MOVB CTTBL(R5),R0 ;GET CHARACTERISTICS BEQ 7$ ;QUESTIONABLE BIT #CT.LC,R0 ;LOWER CASE? BEQ 5$ ; NO .IF NDF XEDLC BIT #ED.LC,EDMASK ;LOWER CASE ENABLED? BNE 4$ ; NO, CONVERT TO UPPER ADD #240,R5 ;YES, END UP WITH "200 + LC" .ENDC 4$: SUB #40,R5 ;CONVERT LOWER TO UPPER CASE BR 5$ ;STORE 7$: MOVB R5,(R2) ;QUESTIONABLE, ASCIZ NULL? BEQ GETL09 ; YES, ALL SET ERROR I ;NO, ILLEGAL CHARACTER MOV #200,R5 ;STORE ZERO WITH FLAG BIT BR 5$ GETL09: .IF NDF XEDCDR MOVB LINBUF+72.,CDRSAV ;SAVE COLUMN 73 BIT #ED.CDR,EDMASK ;CARD READER TYPE? BNE 38$ ; NO CLRB LINBUF+72. ;YES, FORCE EOL .ENDC 38$: MOV #LINBUF,CHRPNT SETNB BNE 39$ ;ALL SET IF NON-NULL LINE TST FFCNT ;NULL, FORM FEED? BEQ 39$ ; NO JMP GETL01 ;YES, JUST BUMP PAGE COUNT 39$: MOV ENDFLG,R0 ;RETURN WITH "ENDFLG" AS ARGUMENT RETURN GETL20: .IF NDF XSML TST SMLLVL ;PROCESSING SYSTEM MACRO? BEQ 1$ $READW SML ;YES, READ THE NEXT LINE CLR R0 ;ASSUME OK BIT #IO.EOF,IOFTBL+SMLCHN ;EOF? BEQ 2$ ; NO INC R0 ;YES, SET R0 BIS R0,ENDFLG ; AND END FLAG 2$: MOV CNTTBL+SMLCHN,R1 ;POINT TO COUNT MOV @R1,R4 CLR @R1 ;SET STOPPER MOV BUFTBL+SMLCHN,R1 ;POINT TO BUFFER RETURN .ENDC 1$: .IF NDF XMACRO MOV MSBMRP,R1 ;POINTING TO MACRO? BNE GETL10 ; YES, PROCESS IT .ENDC CALL GETPLI ;GET PHYSICAL LINE FROM EXEC TST R0 ;NORMAL? BLE 4$ ; YES ERROR E ;EOF, ERROR INC ENDFLG ;FLAG IT 4$: BIT #IO.ERR,IOFTBL+SRCCHN ;ERROR? BEQ 5$ ; NO ERROR L ;YES, FLAG IT 5$: MOV CNTTBL+SRCCHN,R1 ;POINT TO COUNT MOV @R1,R4 ;GET COUNT CLR @R1 ;SET STOPPER MOV BUFTBL+SRCCHN,R1 ;POINT TO INPUT BUFFER .IF NDF XLCSEQ INC LINNUM ;INCREMENT LINE COUNT .ENDC RETURN .IF NDF XMACRO GETL10: CALL 20$ ;MOVE A CHARACTER BGT GETL10 ;LOOP IF GT ZERO BEQ 19$ ;END IF ZERO MOVB -(R2),R0 ;TERMINATOR, BACK UP POINTER CMP R0,#MT.MAX ;END OF TYPE? BLOS 22$ ; YES MOV R1,-(SP) ;REMEMBER READ POINTER MOV MSBARG,R1 TST (R1)+ MOV R2,R3 ; AND WRITE POINTER NEG R0 ;ASSUME MACRO CMP MSBTYP,#MT.MAC ;TRUE? BEQ 12$ ; YES, USE IT MOV MSBCNT,R0 ;GET ARG NUMBER 12$: MOV R3,R2 ;RESET WRITE POINTER 13$: CALL 20$ ;MOVE A BYTE BGT 13$ ;LOOP IF PNZ BLT 14$ ;END IF LESS THAN ZERO SOB R0,12$ ;LOOP IF NOT THROUGH 14$: TSTB -(R2) ;YES, BACK UP POINTER MOV (SP)+,R1 ;RESET READ POINTER BR GETL10 ;END OF ARGUMENT SUBSTITUTION 19$: MOV R1,MSBMRP ;END OF LINE, SAVE POINTER BIS #LC.ME,LCFLAG ;FLAG AS MACRO EXPANSION MOV #1,R0 ;EXIT GETLIN ROUTINE RETURN 20$: BIT #BPMB-1,R1 ;MACRO, END OF BLOCK? BNE 21$ ; NO MOV -BPMB(R1),R1 ;YES, POINT TO NEXT BLOCK TST (R1)+ ;MOVE PAST LINK 21$: CMP R2,#LINBUF+SRCLEN ;OVERFLOW? BLOS 23$ ; NO ERROR L ;YES, FLAG ERROR TSTB -(R2) ; AND MOVE POINTER BACK 23$: MOVB (R1)+,(R2)+ ;MOVE CHAR INTO LINE BUFFER RETURN 22$: CALL ENDMAC ;CLOSE MACRO MOV #-1,R0 ;RE-PROCESS LINE RETURN .ENDC ENTSEC IMPPAS LPPCNT: .BLKW 1 ;FORCE NEW PAGE WHEN NEGATIVE FFCNT: .BLKW 1 ;UNPROCESSED FF COUNT PAGNUM: .BLKW 1 ;PAGE NUMBER PAGEXT: .BLKW 1 ;PAGE NUMBER EXTENSION .IF NDF XLCSEQ LINNUM: .BLKW 2 ;CREF LINE NUMBER SEQEND: .BLKW 1 .ENDC XITSEC ENDLIN: ;END OF LINE PROCESSOR SAVREG CLR ROLUPD ;SET TO FETCH FROM CODE ROLL TSTB CTTBL(R5) ;EOL OR SEMI-COLON? BLE 1$ ; YES ERROR Q 1$: .IF NDF XEDCDR MOVB CDRSAV,LINBUF+72. ;REPLACE BORROWED CHAR .ENDC MOV PASS,-(SP) ;PASS 1? BEQ 9$ ; YES MOV LSTDEV,(SP) ;INIT LISTING FLAG TST ERRBTS ;ANY ERRORS? BNE 7$ ; YES, GO DIRECTLY, DO NOT COLLECT, ETC. TSTB (SP) ;ANY LISTING DEVICE? BEQ 9$ ; NO BIT #LC.LD,LCFLAG ;LISTING DIRECTIVE? BNE 5$ ; YES TST LCLVL ;TEST OVER-UNDER RIDE BLT 5$ ;IF <0, LIST ONLY IF ERRORS BGT 8$ ;IF >0, LIST UNCONDITIONALLY BIT #LC.COM,LCMASK ;COMMENT SUPPRESSION? BEQ 2$ ; NO MOV CHRPNT,LCENDL ;YES, ASSUME WE'RE SITTING AT COMMENT 2$: BIT #LC.SRC,LCMASK ;LINE SUPPRESSION? BEQ 3$ ; NO MOV #LINBUF,LCENDL ;YES, POINT TO START OF BUFFER 3$: .IF NDF XMACRO TSTB ROLSIZ+CODROL+1 ;ANYTHING IN CODE ROLL? BEQ 4$ ; NO BIT #LC.MEB,LCMASK ;MACRO BINARY EXPANSION? BNE 4$ ; NO BIC #LC.ME,LCFLAG ;YES, IGNORE ME FLAG .ENDC 4$: BIT LCMASK,LCFLAG ;ANYTHING SUPPRESSED? BEQ 9$ ; NO, USE CURRENT FLAGS 5$: CLR (SP) ;YES, CLEAR LISTING MODE BR 9$ 7$: SWAB (SP) ;ERROR, SET TO ERROR FLAGS .IF NDF XLCSEQ .IF NDF XLCTTM BIT #LC.TTM,LCMASK ;TELETYPE MODE? BNE 8$ ; NO, BYPASS EXTRA LINE .ENDC MOV #STARS,R1 ;"******" MOV #OCTBUF,R2 MOVBYT ;MOVE INTO OCTAL BUFFER MOVB #SPACE,(R2)+ CALL TSTERR ;SET ERRORS CLRB (R2) ;FORM ASCIZ MOVB (SP),LSTREQ PUTLIN #OCTBUF ;DRAW THE USER'S ATTENTION .ENDC 8$: MOV #LINBUF,LCBEGL ;LIST ENTIRE LINE MOV #LINEND,LCENDL 9$: CALL PCROLL ;PROCESS ENTRY ON CODE ROLL ENDL10: MOVB (SP),LSTREQ ;ANYTHING REQUESTED? BEQ ENDL20 ; NO CLRB @LCENDL ;SET ASCIZ TERMINATOR MOV #OCTBUF,R2 11$: MOV #SPACE*400+SPACE,(R2)+ ;BLANK FILL CMP #LINBUF,R2 ;TEST FOR END (BEGINNING OF LINE BUFFER) BNE 11$ .IF NDF XLCTTM BIT #LC.TTM,LCMASK ;TELETYPE MODE? BNE ENDL50 ; NO .ENDC MOV #PF0,R1 BIT #LC.LOC,LCMASK ;LOCATION COUNTER SUPPRESSED? BNE 14$ ;YES TST (R1) ;ANYTHING FOR FIRST PRINT FIELD? BEQ 14$ ; NO MOV #OCTPF0,R2 ;YES, POINT TO IT CALL SETWRD ;UNPACK INTO BUFFER 14$: CLR (R1) ;CLEAR PF0 MOV #PF1,R1 BIT #LC.BIN,LCMASK ;BINARY SUPPRESSED? BNE 15$ ;YES TST (R1) ;ANYTHING FOR SECOND FIELD? BEQ 15$ ; NO MOV #OCTPF1,R2 CALL SETWDB ;LIST WORD OR BYTE BIT #77*400,(R1) ;TEST FOR LINKER MODIFICATION BEQ 15$ MOVB #CH.XCL,(R2) ; "'" BIT #GLBFLG,(R1) BEQ 15$ MOVB #LET.G,(R2) 15$: CLR (R1) ;CLEAR PF1 .IF NDF XLCSEQ MOV #OCTSEQ,R2 MOV #LINNUM,R0 ;CHECK FOR EXPANSION LINES MOV (R0)+,R1 ;GET CURRENT LINE NUMBER CMP R1,@R0 ;SAME? BEQ 16$ ;YES - SKIP IT MOV R1,@R0 ;ELSE SET NEW LINE BIT #LC.SEQ,LCMASK ;SUPPRESSED? BNE 16$ ; YES DNC MOV R2,SEQEND ;MARK HIGHEST SEQUENCE END 16$: MOVB #SPACE,(R2)+ CMP R2,SEQEND ;THROUGH? BLOS 16$ ; NO .ENDC MOV #OCTERP,R2 CALL TSTERR ;TEST FOR ERRORS MOV #OCTBUF+16.,R2 ;SET FOR CONCATENATION ENDL19: MOV LCBEGL,R1 ;POINT TO START OF LISTING LINE MOVBYT ;MOVE OVER PUTLIN #OCTBUF ;TEST FOR HEADER AND LIST ENDL20: CLRB @LCBEGL ;DON'T DUPE LINE .IF NDF XLCTTM TST ROLUPD ;FINISHED? BEQ ENDL30 ; YES, DON'T LOOP .ENDC CALL PCROLL BEQ ENDL30 ;EXIT IF EMPTY BIT #LC.BEX!LC.BIN,LCMASK ;BINARY EXTENSION SUPPRESSED? BEQ ENDL10 ; NO BR ENDL20 ;YES, DON'T LIST ENDL30: TST (SP)+ ;PRUNE LISTING FLAG ZAP CODROL ;CLEAR THE CODE ROLL MOV CLCLOC,R0 .IF DF YPHASE SUB PHAOFF,R0 .ENDC CMP R0,CLCMAX ;NEW HIGH FOR SECTOR? BLOS 31$ ; NO MOV R0,CLCMAX ;YES, SET IT 31$: RETURN .IF NDF XLCTTM ENDL50: MOV #OCTBUF,R2 ;POINT TO START OF BUFFER CALL TSTERR ;SET ERROR FLAGS .IF NDF XLCSEQ MOV #LINNUM,R0 ;CHECK FOR NEW LINE MOV (R0)+,R1 ;GET CURRENT LINE NUMBER CMP R1,@R0 ;SAME? BEQ 2$ ;YES MOV R1,@R0 ;ELSE REMEMBER IT BIT #LC.SEQ,LCMASK BNE 2$ MOV R2,R4 DNC MOV #OCTBUF+7,R0 1$: MOVB -(R2),-(R0) MOVB #SPACE,(R2) CMP R2,R4 BHI 1$ .ENDC MOV #OCTBUF+7,R2 2$: MOVB #TAB,(R2)+ MOV #PF0,R1 BIT #LC.LOC,LCMASK BNE 4$ TST (R1) BEQ 3$ CALL SETWRD 3$: MOVB #TAB,(R2)+ 4$: CLR (R1) MOV #PF1,R1 BIT #LC.BIN,LCMASK BNE ENDL19 MOV #3,R4 5$: TST (R1) BEQ 6$ CALL SETWDB BIT #77*400,(R1) BEQ 6$ MOVB #CH.XCL,(R2)+ BIT #GLBFLG,(R1) BEQ 6$ MOVB #LET.G,-1(R2) 6$: MOVB #TAB,(R2)+ CLR (R1) DEC R4 BEQ ENDL19 TST ROLUPD BEQ 6$ CALL PCROLL BR 5$ .ENDC TSTERR: ;TEST AND PROCESS ERRORS MOV ERRBTS,R0 ;ANY ERRORS? BEQ TSTER9 ; NO ENTOVR 9 BIC #ERR.,R0 ;YES, ".PRINT"? BEQ 4$ ; YES INC ERRCNT ;BUMP ERROR COUNT 4$: MOV #ERRMNE-1,R1 1$: TSTB (R1)+ ;MOVE CHAR PNTR AND CLEAR CARRY ROR ERRBTS ;ROTATE ERROR BITS BCC 2$ MOVB (R1),(R2)+ .IF NDF XCREF MOVB (R1),R0 ;FETCH CHARACTER TSTR50 ;CONVERT TO RAD50 CALL MULR50 ;LEFT JUSTIFY CALL MULR50 MOV R0,SYMBOL ;STORE CLR SYMBOL+2 MOV #ERRROL,ROLNDX ;PREPARE TO CREF CRFREF ;DO SO .ENDC BR 1$ 2$: BNE 1$ XITOVR INLINE TSTER9: RETURN ENTSEC IMPURE ERRCNT: .BLKW ;ERROR COUNTER ENTSEC IMPLIN ERRBTS: .BLKW ;ERROR FLAGS XITSEC .IF NDF XEDCDR GENEDT CDR,,1 ENTSEC IMPURE CDRSAV: .BLKW ;SAVED CHAR FROM CARD FORMAT .ENDC ENTSEC IMPURE OCTBUF: OCTERP: .BLKB 0 OCTSEQ: .BLKB 2 OCTPF0: .BLKB 7 OCTPF1: .BLKB OCTLEN-<.-OCTBUF> LINBUF: .BLKW LINLEN/2 LINEND: .BLKW 1 XITSEC .SBTTL STATEMENT PROCESSOR STMNT: MOV CNDWRD,R0 ;IN CONDITIONAL? BIS CNDMEX,R0 ; OR MEXIT? BNE 40$ ; YES, BRANCH IF SUPPRESSED GETSYM BEQ 20$ CMP R5,#CH.COL ; ":" BEQ LABEL CMP R5,#CH.EQU ; "=" BNE 1$ ; NO JMP ASGMT ;YES, PROCESS IT 1$: .IF NDF XMACRO MSRCH BEQ 2$ CRFREF JMP MACROC ;MACRO CALL .ENDC 2$: OSRCH BEQ 30$ CRFREF 10$: JMP PROPC ;PROCESS OP CODE 20$: .IF NDF XEDLSB MOV #10.,R2 ;NOT SYMBOL, PERHAPS LOCAL SYMBOL? CVTNUM BEQ 30$ ; NO CMP R5,#CH.DOL ;NUMBER, TERMINATED BY "$"? BNE 30$ ; NO GETNB CMP R5,#CH.COL BNE 30$ .IF NDF RSX11D MOV CLCLOC,R0 SUB LSYBAS,R0 ;COMPUTE LOCAL OFFSET BIT #177400,R0 ;IN RANGE BEQ 21$ ; YES ERROR A ;NO, ERROR .ENDC 21$: LSRCH ;YES, DO A LOCAL SYMBOL SEARCH BR LABELF ;EXIT THROUGH LABEL PROCESSOR .ENDC 30$: SETSYM ;RESET CHAR POINTER AND FLAGS TSTB CTTBL(R5) BLE 42$ ;NULL IF END OF LINE MOV #WRDSYM,R1 ;NEITHER, FUDGE ".WORD" DIRECTIVE MOV #SYMBOL,R2 CALL XMIT4 ;MOVE PST ENTRY TO "SYMBOL" BR 10$ 40$: CALL SETCLI ;UNSAT CONDITIONAL, TEST DIRECTIVE BMI 41$ ; BRANCH IF EOF BIT #DFLCND,R0 ;CONDITIONAL? BNE 10$ ; YES, PROCESS IT BIS #LC.CND,LCFLAG ;MARK AS UNSAT CONDITIONAL 41$: CLR R5 42$: RETURN ;IGNORE LINE SETCLI: ENTOVR 5 1$: GETSYM ;TRY FOR SYMBOL .IF NDF XEDLSB BNE 3$ ;BRANCH IF FOUND BITB #CT.NUM,CTTBL(R5) ;PERHAPS A LOCAL? BEQ 5$ ; NO 2$: GETCHR ;PERHAPS, TEST NEXT BITB #CT.ALP!CT.NUM,CTTBL(R5) ;ALPHA/NUMERIC? BNE 2$ ; YES, TRY AGAIN SETNB ;NO, BYPASS ANY BLANKS .IFF BEQ 5$ ; EXIT IF NO SYMBOL .ENDC 3$: CMP R5,#CH.EQU ;ASSIGNMENT (=)? BEQ 5$ ; YES, IGNORE THIS LINE CMP R5,#CH.COL ;LABEL (:)? BNE 4$ ; NO GETNB ;YES, BYPASS COLON BR 1$ ; AND CONTINUE 4$: OSRCH ;TRY FOR OP-CODE MOV MODE,R0 ;MODE TO R0 BPL 6$ ;BRANCH IF DIRECTIVE 5$: CLR R0 ;FALSE 6$: RETURN XITOVR LABEL: ;LABEL PROCESSOR .ENABL LSB CMP SYMBOL,R50DOT ;PERIOD? BEQ 4$ ; YES, ERROR .IF NDF XEDLSB CALL LSBSET ;FLAG START OF NEW LOCAL SYMBOL BLOCK .ENDC SSRCH ;NO, SEARCH THE SYMBOL TABLE CRFDEF LABELF: SETXPR ;SET EXPRESSION REGISTERS GETNB ;BYPASS COLON .IF DF RSX11D CMP R5,#CH.COL BNE 10$ MOV #GLBFLG,DFGTMP GETNB 10$: .ENDC BIT #DEFFLG,(R3) ;ALREADY DEFINED? BNE 1$ ; YES MOV CLCFGS,R0 ;NO, GET CURRENT LOCATION CHARACTERISTICS BIC #377-<RELFLG>,R0 ;CLEAR ALL BUT RELOCATION FLAG BIS #DEFFLG!LBLFLG,R0 ;FLAG AS LABEL .IF DF RSX11D BIS DFGTMP,R0 BIT #DFGFLG,(R3) BEQ 11$ BIC #DFGFLG!GLBFLG,(R3) 11$: .ENDC BIS R0,(R3) ;SET MODE MOV CLCLOC,(R4) ; AND CURRENT LOCATION BR 30$ ;INSERT 1$: BIT #LBLFLG,(R3) ;DEFINED, AS LABEL? BEQ 20$ ;NO CMP CLCLOC,(R4) ;HAS ANYBODY MOVED? BNE 2$ ; YES CMPB CLCSEC,(R2) ;SAME SECTOR? BEQ 3$ ; YES, OK 2$: TST PASS ;IS THIS PASS ONE? BEQ 20$ ;YES, TRUE MULTIPLE DEFINITION BIT #MDFFLG,(R3) ;DID PASS 1 FIND MULTIPLE DEFINITION? BNE 21$ ;YES,GIVE M ERROR ERROR P ;NO ,IT IS A PHASE ERROR BR 30$ ;DON'T SAY M ERROR 20$: BIS #MDFFLG,(R3) ;AND SET TO MULTIPLY DEFINED 3$: BIT #MDFFLG,(R3) ;TEST IF MULTIPLY DEFINED BEQ 30$ 21$: ERROR M ;SET M ERROR IF SO 30$: INSERT ;INSERT/UPDATE SETPF0 ;BE SURE TO PRINT LOCATION FIELD BR 5$ 4$: ERROR Q 5$: MOV CHRPNT,LBLEND ;MARK END OF LABEL .IF DF RSX11D CLR DFGTMP ENTSEC IMPURE DFGTMP: .BLKW XITSEC .ENDC JMP STMNT ;TRY FOR MORE .DSABL LSB .SBTTL ASSIGNMENT PROCESSOR ASGMT: ENTOVR 2 GETNB ;BYPASS "=" .IF DF RSX11D CMP R5,#CH.EQU BNE 10$ MOV #GLBFLG,DFGTMP GETNB 10$: .IFTF MOV #SYMBOL+4,R1 ;SET MIX-MASTER REGISTER MOV -(R1),-(SP) ;STACK SYMBOL MOV -(R1),-(SP) RELEXP ;GET NON-EXTERNAL EXPRESSION MOV (SP)+,(R1)+ ;RESTORE SYMBOL MOV (SP)+,(R1)+ BIT #ERR.U,ERRBTS ;ANY UNDEFINED'S? BNE ASGMTX ; YES, DON'T DEFINE ASGMTF: SETPF1 ;SET LISTING FIELD SETXPR ;SET EXPRESSION REGISTERS BIT #ERR.A,ERRBTS BNE ASGMTX BIS #DEFFLG,(R3) ;FLAG AS DEFINED MOV (R3),-(SP) ;NO, STACK VALUE MOV (R4),-(SP) SSRCH ;SEARCH SYMBOL TABLE MOV (SP)+,(R4) ;RESTORE VALUE .IFT BIT #DFGFLG,(R3) BEQ 11$ BIC #DFGFLG!GLBFLG,(R3) 11$: .IFTF BIC #^C<GLBFLG>,(R3) BIS (SP)+,(R3) CMP (R1),R50DOT ;MESSING WITH THE PC? BEQ 1$ ; YES .IFT BIS #DFGFLG,(R3) .IFTF INSERT ;INSERT NEW VALUE BR ASGMTX 1$: CMPB (R2),CLCSEC ;SAME SECTOR? BNE 2$ ; NO, ERROR MOV (R4),CLCLOC ;YES, SET NEW LOCATION BR ASGMTX 2$: ERROR M ASGMTX: CRFDEF .IFT CLR DFGTMP .ENDC RETURN XITOVR .SBTTL OP CODE PROCESSOR PROPC: ;PROCESS OP CODE MOV #MODE,R4 ;POINT TO MODE MOV (R4),R1 ;LEAVE RESULT IN R1 CLR (R4)+ ;SET TO ZERO, POINT TO VALUE MOV #CLCLOC,R2 ;POINT R2 TO LOCATION COUNTER BIT #100000+DFLGEV,R1 ;OP CODE OR EVEN DIRECTIVE? BEQ 1$ ; NO BIT #1,(R2) ;YES, CURRENTLY EVEN? BEQ 1$ ; YES INC (R2) ;NO, MAKE IT EVEN ERROR B ; AND FLAG ERROR 1$: BIT #DFLGBM,R1 ;BYTE MODE DIRECTIVE? BEQ 2$ ; NO INC BYTMOD ;YES, SET FLAG 2$: TST R1 ;OP-CODE? BMI 10$ ; YES MOV (R4),-(SP) ;NO, DIRECTIVE. CLR (R4) ;CLEAR VALUE CLR R3 ;START WITH R3=0 JMPOVR (SP)+ ;GO TO PROPER HANDLER 10$: MOV #077776,PCRCNT ;LIST LOCATION OF FIRST WORD ONLY STCODE ;STUFF BASIC VALUE .IF NDF XCREF MOVB R1,CRFDFL+1 ;SET "*" CREF MARKERS .IFTF SWAB R1 BIC #177600,R1 ;CLEAR HIGH ORDER BITS MOV R1,OPCLAS ;SAVE CLASS ASL R1 ASL R1 ;FOUR BYTES PER TABLE ENTRY CLR -(SP) ;SET A STOPPER MOV OPJTBL+2(R1),-(SP) ;STACK SECOND ARG BNE 11$ ;BRANCH IF TWO ARGS TST (SP)+ ;ONE ARG, PRUNE TERMINATOR 11$: MOV OPJTBL(R1),R1 ;SET THE FIRST ARGUMENT BEQ 14$ ;BRANCH IF NO ARGS 12$: MOV R1,-(SP) ;SAVE A COPY OF THE ARG SWAB (SP) ;SHIFT COUNT TO RIGHT HALF BIC #177400,R1 ;ISOLATE LOW BYTE TSTARG ;COMMA TEST CLR R0 ;FUNCTION REGISTER CALL OPJBAS(R1) ;CALL PROPER ROUTINE .IFT ROLB CRFDFL+1 ;MOVE SECOND FIELD BIT .ENDC 13$: ASL R0 ;SHIFT RESULT DECB (SP) ;COUNT IN SP, RH BGE 13$ ROR R0 ;WE WENT ONE TOO MANY MOV ROLBAS+CODROL,R1 BIS R0,6(R1) ;SET EXPRESSION BITS TST (SP)+ ;PRUNE WORK ENTRY 14$: MOV (SP)+,R1 ;GET NEXT ARG FROM STACK BNE 12$ ;BRANCH IF NOT TERMINATOR .IF NDF XZERR MOV ROLBAS+CODROL,R1 MOV 6(R1),R0 ;SET FOR "Z" ERROR TESTS MOV R0,R1 BIC #000007,R1 CMP #000120,R1 ; JMP (R)+ BEQ 22$ BIC #000700,R1 CMP #004020,R1 ; JSR X,(R1)+ BEQ 22$ MOV R0,R1 BIT #007000,R1 ;FIRST ARG TYPE 0? BNE 23$ ; NO, OK BIC #100777,R1 BEQ 23$ CMP #070000,R1 ;DOUBLE ADDRESS TYPE? BEQ 23$ ; NO MOV R0,R1 BIC #170017,R1 CMP #000760,R1 ; MOV PC,[@]X(R) BEQ 22$ BIC #177717,R1 CMP #000020,R1 ; (R)+ BEQ 21$ CMP #000040,R1 ; -(R) BNE 23$ 21$: MOV R0,R1 ROL R1 ROL R1 SWAB R1 SUB R0,R1 BIT #000007,R1 ; R1=R2 BNE 23$ 22$: ERROR Z 23$: .ENDC CPOPJ: RETURN .MACRO GENOPJ NUMBER,SUBR1,SC1,SUBR2,SC2 ;OP CODE JUMP TABLE .GLOBL OPCL'NUMBER OPCL'NUMBER= <.-OPJTBL>/4 .IIF NB <SUBR1>, .BYTE SUBR1-OPJBAS .IIF B <SUBR1>, .BYTE 0 .BYTE SC1+0 .IIF NB <SUBR2>, .BYTE SUBR2-OPJBAS .IIF B <SUBR2>, .BYTE 0 .BYTE SC2+0 .ENDM ENTSEC DPURE OPJTBL: ;OP CODE JUMP TABLE GENOPJ 00 GENOPJ 01, AEXP GENOPJ 02, AEXP, 6, AEXP GENOPJ 03, REGEXP GENOPJ 04, BROP GENOPJ 05, REGEXP, 6, AEXP GENOPJ 06, TRAPOP .IF NDF X45 GENOPJ 07, AEXP, 0, REGEXP, 6 GENOPJ 08, REGEXP, 6, SOBOP GENOPJ 09, AEXP, 0, REGEXP, 6 GENOPJ 10, MARKOP GENOPJ 11, AEXP, 0, DRGEXP, 6 GENOPJ 12, DRGEXP, 6, AEXP, 0 GENOPJ 13, SPLOP GENOPJ 14, AEXP, 0, DRGEXP, 6 .ENDC ENTSEC IMPLIN OPCLAS: .BLKW ;OP CODE CLASS XITSEC OPJBAS: ;INDEX BASE FOR FOLLOWING ROUTINES RETURN REGEXP: ;REGISTER EXPRESSION ABSEXP ;EVALUATE ABSOLUTE BIT #177770,R0 ;ANY OVERFLOW? BEQ 1$ ; NO ERROR R ;YES, FLAG ERROR BIC #177770,R0 ;CLEAR OVERFLOW 1$: RETURN BROP: ;BRANCH DISPLACEMENT TYPE RELEXP CMPB SECTOR,CLCSEC BNE 2$ SUB CLCLOC,R0 ASR R0 BCS 2$ DEC R0 MOVB R0,R3 ;EXTEND SIGN CMP R0,R3 ;PROPER? BEQ 3$ ; YES 2$: ERROR A MOV #000377,R0 3$: BIC #177400,R0 ;CLEAR POSSIBLE HIGH BITS RETURN TRAPOP: ;TRAP TYPE ENTOVR 2 SETXPR ;SET EXPRESSION REGISTERS MOV (R4),-(SP) ;SAVE THE VALUE EXPR ;EVALUATE THE EXPRESSION (NULL OK) INC BYTMOD ;TREAT AS BYTE SETIMM CMPB (R2),#200 ;ABSOLUTE? BNE 1$ ; NO TST (SP)+ ;YES, PRUNE STACK MOV (R4),R0 ;VALUE TO MERGE RETURN 1$: ZAP CODROL ;CLEAR CODE ROLL STCODE ;STORE ADDRESS MOV #100000,(R3) ;SET FOR ABSOLUTE BYTE SWAB (SP) MOV (SP)+,(R4) ;SET ORIGIONAL VALUE STCODE CLR R0 RETURN XITOVR .IF NDF X45 DRGEXP: ;DOUBLE REGISTER EXPRESSION CALL REGEXP ;EVALUATE NORMAL MOV #177774,R3 ;TEST FOR OVERFLOW BR MASKR3 SOBOP: ;SOB OPERATOR CALL BROP ;FREE-LOAD OFF BRANCH OPERATOR MOVB R0,R0 ;EXTEND SIGN NEG R0 ;POSITIVE FOR BACKWARDS BR MASKB6 ;MASK TO SIX BITS SPLOP: ;SPL TYPE ABSEXP MOV #177770,R3 ;ONLY THREE BITS ALLOWED BR MASKR3 MARKOP: ;MARK OPERATOR ABSEXP ;EVALUATE ABSOLUTE MASKB6: MOV #177700,R3 ;SET TO MASK HIGH ORDER MASKR3: BIT R3,R0 ;OVERFLOW? BEQ 1$ ; NO ERROR T ;YES, FLAG TRUNCATION ERROR BIC R3,R0 ;CLEAR EXCESS 1$: RETURN .ENDC AEXP: SAVREG ;ADDRESS EXPRESSION EVALUATION SETXPR ; AND SET "EXPRESSION" TYPE INC EXPFLG CLR -(SP) ;ACCUMULATE ON TOP OF STACK AEXP02: CHSCAN AEXTBL ;TEST FOR OPERATOR BEQ AEXP22 ; NO JMP (R0) ;YES, GO TO IT ENTSEC DPURE AEXTBL: ;ADDRESS EXPRESSION TABLE GCHTBL CH.IND, AEXP03 ; "@" GCHTBL CH.HSH, AEXP06 ; "#" GCHTBL CH.SUB, AEXP10 ; "-" GCHTBL CH.LP, AEXP12 ; "(" .WORD 0 ;TERMINATOR XITSEC AEXP03: TST (SP) ;"@", SECOND TIME AROUND? BEQ 4$ ; NO ERROR Q ; YES 4$: BIS #AM.DEF,(SP) ;SET IT BR AEXP02 AEXP06: ;LITERAL (#) .IF NDF XFLTG CMP #OPCL11,OPCLAS ;CLASS 11? BNE 8$ ; NO CALL FLTG1W ;YES, TRY FOR ONE-WORD FLOATING BNE 9$ ;BRANCH IF OK .ENDC 8$: GLBEXP ;EVALUATE EXPRESSION 9$: BIS #AM.IMM,(SP) ;SET BITS BR AEXP32 ;USE COMMON EXIT AEXP10: ;AUTO-DECREMENT (-) CMP R5,#CH.LP ;FOLLOWED BY "("? BNE AEXP20 ; NOT A CHANCE CALL AEXPLP ;PROCESS PARENS BIS #AM.DEC,(SP) BR AEXP36 AEXP12: ; "(" CALL AEXPL1 ;EVALUATE REGISTER CMP R5,#CH.ADD ;AUTO-INCREMENT (+)? BNE 14$ ; NO GETNB ;YES, POLISH IT OFF BIS #AM.INC,(SP) ;SET BITS BR AEXP36 14$: BIT #AM.DEF,(SP) ;INDIRECT SEEN? BNE 16$ ; YES BIS #AM.DEF,(SP) ;NO, SET BIT BR AEXP36 16$: CLR (R3) ;MODE CLR (R4) ; AND VALUE BR AEXP30 AEXP20: SETSYM ;AUTO-DEC FAILURE, POINT TO - AEXP22: GLBEXP ;GET AN EXPRESSION CMP R5,#CH.LP ;INDEXED? BEQ 24$ ; YES BIT #REGFLG,(R3) ;FLAGS BNE AEXP36 .IF NDF XEDPIC!XEDAMA TST (SP) BNE 23$ .IF NDF XEDPIC BIT #ED.PIC,EDMASK BNE 1$ BIT #GLBFLG,(R3) BNE 2$ CMPB (R2),CLCSEC BEQ 23$ BR 2$ 1$: .ENDC .IF NDF XEDAMA BIT #ED.AMA,EDMASK ;ABSOLUTE MODE REQUESTED? BNE 23$ ; NO .ENDC 2$: BIS #AM.IMM!AM.DEF,(SP) ;OK, SET ABS MODE BR AEXP32 .ENDC 23$: BIS #AM.REL,(SP) ;NO SETDSP ;SET DISPLACEMENT BR AEXP34 24$: BIT #REGFLG,(R3) ;FLAGS BEQ 26$ ERROR R BIC #REGFLG,(R3) ;FLAGS 26$: MOV (R1)+,-(SP) ;STACK CURRENT VALUE MOV (R1)+,-(SP) MOV (R1)+,-(SP) MOV (R1)+,-(SP) CALL AEXPLP ;PROCESS INDEX MOV (SP)+,-(R1) ;RESTORE MOV (SP)+,-(R1) MOV (SP)+,-(R1) MOV (SP)+,-(R1) AEXP30: BIS R0,(SP) BIS #AM.NDX,(SP) AEXP32: SETIMM AEXP34: STCODE CLR R0 AEXP36: BIS (SP)+,R0 RETURN AEXPLP: ;AEXP PAREN PROCESSOR GETNB ;BYPASS PAREN AEXPL1: CALL REGEXP ;GET A REGISTER EXPRESSION CMP R5,#CH.RP ;HAPPY ENDING ")"? BNE 1$ ; NO JMP GETNB ;YES, BYPASS AND EXIT 1$: ERROR Q ;NO RETURN .IF NDF XEDAMA GENEDT AMA,,1 ;ABSOLUTE MODE ADDRESSING .ENDC .IF NDF XEDPIC GENEDT PIC,,1 ;PIC MODE .ENDC .SBTTL EXPRESSION TO CODE-ROLL CONVERSIONS SETIMM: ;SET IMMEDIATE MODE SAVREG ;SAVE REGISTERS SETXPR ; AND SET "EXPRESSION" TYPE .IF NDF XREL MOV #IMMMOD,R1 ;SET TABLE INDEX TST ENDFLG ;SPECIAL FOR .END? BNE SETDS1 ; YES BITB #GLBFLG,(R3) ;EXTERNAL? BNE SETDS3 ; YES, USE COMMON HANDLER CMPB (R1)+,(R1)+ ;MOVE INDEX BITB #RELFLG,(R3) ;RELOCATABLE? BEQ SETDSX ; NO, ALL SET TSTB (R1)+ CMPB (R2),CLCSEC ;YES, CURRENT SECTOR? BNE SETDS1 ; NO .IFTF BR SETDSX ;YES SETDSP: ;SET DISPLACEMENT MODE SAVREG ;SAVE REGISTERS SETXPR ; AND SET "EXPRESSION" TYPE .IFT MOV #DSPMOD,R1 ;SET INDEX BITB #GLBFLG,(R3) ;EXTERNAL? BNE SETDS3 ; YES, TEST FOR ADDITIVE CMPB (R1)+,(R1)+ CMPB (R2),CLCSEC ;CURRENT SECTOR? BEQ SETDS2 ; YES TSTB (R1)+ TSTB (R2) ;LOOKING AT ABSOLUTE? BEQ SETDSX ; YES SETDS1: TSTB (R1)+ CLR R0 ;CLEAR HIGH ORDER BISB (R2),R0 ;SET SECTOR IMULI RS.SEC*2,R0 ;MULTIPLY BY BYTES/BLOCK ADD ROLBAS+SECROL,R0 ;COMPUTE BASE OF SECTOR ROLL MOV (R0)+,SYMBOL ;XFER SECTOR NAME TO SYMBOL MOV (R0)+,SYMBOL+2 BR SETDSX SETDS2: CLR MODE .IFTF MOVB ROLSIZ+CODROL+1,R0 ;GET CODE ROLL ENTRY NUMBER INC R0 ASL R0 ;MAKE IT 4 OR 6 ADD CLCLOC,R0 SUB R0,(R4) .IFT BR SETDSX SETDS3: .IF DF YPHASE TST PHAOFF BNE 1$ .IFTF TST (R4) ;EXTERNAL, ANY OFFSET? BEQ SETDSX ; NO .IFT 1$: SUB PHAOFF,(R4) .ENDC TSTB (R1)+ ;YES, ADVANCE INDEX .IFTF SETDSX: .IFT .IF NDF XEDPIC BIT #ED.PIC,EDMASK BNE 12$ TSTB (R1) BEQ 12$ CMPB (R2),CLCSEC BEQ 10$ CMP R1,#DSPMOD BHIS 11$ BR 12$ 10$: CMP R1,#DSPMOD BHIS 12$ 11$: ERROR R 12$: .ENDC MOVB (R1),(R2) ;FILL IN TYPE .IFTF TST BYTMOD ;IN BYTE MODE? BEQ 4$ ; NO TSTB (R4)+ ;MOVE TO HIGH BYTE OF "VALUE" MOVB (R4),R0 ;ANY HIGH ORDER BITES? BEQ 1$ ; NO, OK INC R0 ;YES, ALL ONES? BNE 2$ ; NO, YOU LOSE 1$: .IFT CMPB (R2),#RLDT01 ;ERROR IF RLD TYPE 1 BEQ 2$ CMPB (R2),#RLDT15 ; OR 15 BNE 3$ .IFF BR 3$ .IFTF 2$: ABSERR ;FLAG ERROR 3$: CLRB (R4) BISB #200,(R2) ;FLAG AS BYTE 4$: RETURN .IFT ENTSEC TXTBYT IMMMOD: .BYTE RLDT02, RLDT05, RLDT00, RLDT01, RLDT15, 0 DSPMOD: .BYTE RLDT04, RLDT06, RLDT00, RLDT03, RLDT16, 0 .ENDC ENTSEC IMPLIN BYTMOD: .BLKW ;BYTE MODE IF NON-ZERO XITSEC .SBTTL DIRECTIVES SETOVR 3 .IF NDF XREL .GLOBL GLOBL GLOBL: ;GLOBAL HANDLER 1$: GSARG ;GET A SYMBOL BEQ 3$ ; END SSRCH ;NO, SEARCH USER SYMBOL TABLE BIT #REGFLG,FLAGS ;REGISTER? BNE 2$ ; YES, ERROR .IIF DF RSX11D, BIC #DFGFLG,FLAGS BIS #GLBFLG,FLAGS ;NO, FLAG AS GLOBL INSERT ;UPDATE/INSERT CRFDEF BR 1$ 2$: ERROR R BR 1$ 3$: RETURN .ENDC .GLOBL END END: ;TEMP END DIRECTIVE EXPR ;EVALUATE THE EXPRESSION BNE 1$ ; BRANCH IF NON-NULL INC (R4) ;NULL, MAKE IT A ONE 1$: RELTST ;NO GLOBALS ALLOWED INC ENDFLG SETIMM ;FILL OUT BLOCK SETPF1 ;LIST FIELD 1 MOV #SYMBOL,R1 MOV #ENDVEC,R2 JMP XMIT4 ;MOVE TO END VECTOR XITOVR ENTSEC IMPURE ENDVEC: .BLKW 4 ;END VECTOR STORAGE ENTSEC XCTPRG INC ENDVEC+6 ;DEFAULT TO NO END VECTOR XITSEC .IF NDF XREL .IF NDF RSX11D .GLOBL ASECT, CSECT SETOVR 3 ASECT: CALL SETMAX ;CLEAN UP CURRENT SECTOR ASECTF: MOV R50ABS,SYMBOL ;SET ". ABS." MOV R50ABS+2,SYMBOL+2 BR CSECTF ;USE COMMON EXIT CSECT: CALL SETMAX ;CLEAN UP CURRENT SECTOR GETSYM ;GET ARGUMENT (OR NULL) CSECTF: SCAN SECROL ;SCAN FOR MATCH BNE CSECTX ; BRANCH IF MATCH MOVB ROLSIZ+1+SECROL,SECTOR ;NEW GUY, SET SECTOR BEQ 2$ ;BRANCH IF ABS SECTOR (FOR NOW) BIS #RELFLG,MODE 2$: INSERT ;ATTACH TO ROLL .IFTF CSECTX: SETPF1 CRFREF MOV #SYMBOL,R1 MOV #CLCNAM,R2 .IF NDF XEDLSB CALL XMIT5 JMP LSBSET ;SET NEW LOCAL SYMBOL BASE .IFF JMP XMIT5 ;MOVE AND EXIT .ENDC ;XEDLSB XITOVR .IFF .GLOBL ASECT, CSECT, PSECT ASECT: CALL SETMAX ;CLOSE OUT CURRENT SECTION ASECTF: MOV R50ABS,SYMBOL ;SET DEFAULT ABS SECTION NAME MOV R50ABS+2,SYMBOL+2; MOV #ASTFLG,R3 ;GET DEFAULT FLAGS BR CSECTF ; CSECT: CALL SETMAX ;CLOSE OUT CURRENT SECTION MOV #CSTFLG,R3 ;GET DEFAULT FLAGS TSTARG ;ANY NAME? BEQ 10$ ;IF EQ NO BIS #CSTALO!CSTGBL,R3;SET OVERLAID AND GLOBAL 10$: GETSYM ;GET SECTION NAME CSECTF: SCAN SECROL ;SCAN FOR A MATCH BNE PSECTF ;IF NE MATCH FOUND MOVB R3,MODE ;SET MODE FLAGS MOVB ROLSIZ+1+SECROL,SECTOR;SET SECTOR BR PSECTF ; PSECT: CALL SETMAX ;CLOSE OUT CURRENT SECTION TSTARG ;TEST FOR ARGUMENT (SET UP) INC ARGCNT ;INCREMENT ARGUMENT COUNT GETSYM ;GET SECTION NAME SCAN SECROL ;SCAN FOR MATCH BNE 10$ ;IF NE FOUND MATCH MOVB #PSTFLG,MODE ;SET DEFAULT MODE FLAGS MOVB ROLSIZ+1+SECROL,SECTOR;SET SECTOR 10$: MOV #SYMBOL+12,R3 ;GET SET TO STACK SECTION .REPT 5 MOV -(R3),-(SP) ;STACK SECTION .ENDR 20$: TSTARG ;ANY MORE ARGUMENTS? BEQ 30$ ;IF EQ NO GETSYM ;GET ATTRIBUTE SYMBOL SCANW SATROL ;SCAN FOR A MATCH BEQ PSECTA ;IF EQ ERROR MOV #SYMBOL+2,R0 ;GET ADDRESS OF ARGUMENT WORD BICB (R0),4(SP) ;ASSUME BIT IS TO BE CLEARED TST (R0) ;CLEAR OR SET? BPL 20$ ;IF PL CLEAR BISB (R0),4(SP) ;SET BIT BR 20$ ;GO AGAIN 30$: MOV (SP)+,(R3)+ ;RESTORE SECTION NAME MOV (SP)+,(R3)+ ; SCAN SECROL ;SCAN SECTOR ROLL MOV (SP)+,(R3)+ ;RESTORE SECTION ATTRIBUTES MOV (SP)+,(R3)+ ; MOV (SP)+,(R3)+ ; PSECTF: INSERT ;INSERT SECTION SETPF1 ; JMP CSECTX PSECTA: ADD #5*2,SP ;CLEAN STACK ERROR A ;SET ERROR FLAG RETURN ; .ENDC ;RSX11D .IF DF YPHASE .GLOBL PHASE, DEPHA PHASE: RELEXP CMPB SECTOR,CLCSEC BNE 1$ MOV R0,PHAOFF SUB CLCLOC,PHAOFF MOV R0,CLCLOC RETURN 1$: ERROR A RETURN DEPHA: SUB PHAOFF,CLCLOC CLR PHAOFF RETURN ENTSEC IMPPAS PHAOFF: .BLKW XITSEC .ENDC ;YPHASE .ENDC ;XREL SECINI: ENTOVR 3 .IF NDF XREL CALL ASECTF ;MOVE ONTO ROLL CLR SYMBOL ;DITTO FOR BLANK CSECT CLR SYMBOL+2 .IIF DF RSX11D, MOV #CSTFLG,R3 .IF NDF XEDABS BIT #ED.ABS,EDMASK ;ABS MODE? BNE CSECTF ; NO RETURN .IFF BR CSECTF .IFT GENEDT ABS,SECINI,1 .ENDC ;XEDABS .IFF BIT #ED.ABS,EDMASK BEQ 1$ ERROR A BIC #ED.ABS,EDMASK 1$: RETURN GENEDT ABS,SECINI .ENDC ;XREL XITOVR .IF NDF XREL SETMAX: ;SET MAX AND ENTER ONTO ROLL ENTOVR 3 SAVREG ;PLAY IT SAFE MOV #CLCNAM,R1 MOV #SYMBOL,R2 CALL XMIT2 ;MOVE NAME TO SYMBOL SCAN SECROL ;SCAN SECTOR ROLL CALL XMIT3 ;SET REMAINDER OF ENTRIES JMP INSERT ;UPDATE ROLL AND EXIT XITOVR .GLOBL LIMIT SETOVR 9 LIMIT: CALL OBJDMP CLR (R4) ;CLEAR VALUE MOV #RLDT11*400,-(R4) ;SET RLD TYPE STCODE CLR (R4) JMP STCODE XITOVR .ENDC .GLOBL TITLE, SBTTL, IDENT SETHDR: ;ONCE-ONLY DEFAULT SETTER ENTOVR 9 MOV #DEFTTL,CHRPNT ;POINT TO DEFAULT SETCHR ;MAKE IT LOOK LIKE THE REAL THING TITLE: GETSYM ;GET A SYMBOL BNE 1$ ; ERROR IF NULL ERROR A RETURN 1$: MOV R0,PRGTTL ;MOVE INTO STORAGE MOV SYMBOL+2,PRGTTL+2 CALL SETSYM ;POINT TO START OF TITLE MOV #TTLBUF,R2 ;POINT TO BUFFER MOVB #FF,(R2)+ ;STORE PAGE EJECT CLR R3 ;CLEAR POSITION CONTER 2$: MOVB R5,(R2) ;PLUNK THE NEXT CHAR IN THE BUFFER BEQ 5$ ;BRANCH IF END CMP R5,#TAB ;A TAB? BNE 3$ ; NO BIS #7,R3 ;YES, COMPENSATE 3$: INC R3 ;UPDATE POSITION COUNTER CMP R3,#TTLLEN ;WITHIN BOUNDS? BHIS 4$ ; NO TSTB (R2)+ ;YES, MOVE POINTER 4$: GETCHR ;GET THE NEXT CHARACTER BNE 2$ ;LOOP IF NOT END 5$: MOVB #TAB,(R2)+ ;SET SEPARATOR MOV #HDRTTL,R1 MOVBYT ;SET VERSION NUMBER, ETC. .IF NDF XTIME MOV #DATTIM,R1 MOVBYT ;DATE AND TIME .ENDC MOV R2,TTLBRK ;REMEMBER BREAK POINT RETURN ENTSEC TXTBYT DEFTTL: .ASCIZ /.MAIN./ ;DEFAULT TITLE ENTSEC IMPURE TTLBRK: .BLKW ;BREAK LOCATION TTLBUF: .BLKB TTLLEN-1!7+1+1 ;MODULO TAB + FF .BLKB 20. ;INTRO MSG .IIF NDF XTIME, .BLKB 20. ;TIME & DATE .BLKB 20. ;PAGE NUMBER .EVEN XITSEC XITOVR SETOVR 2 SBTTL: ;SUB-TITLE DIRECTIVE MOV #STLBUF,R2 ;POINT TO SUB-TITLE BUFFER TST PASS ;PASS ONE? BEQ 2$ ; YES 1$: MOVB R5,(R2)+ ;MOVE CHARACTER IN BEQ 13$ ; BRANCH IF END GETCHR ;GET THE NEXT CHARACTER CMP R2,#STLBUF+STLLEN-1 ;TEST FOR END BLO 1$ TSTB -(R2) ;POLISH OFF LINE BR 1$ 2$: BIT #LC.TOC,LCMASK BNE 13$ TSTB LSTDEV ;ANY LISTING DEVICE? BEQ 13$ ; NO, EXIT MOV #TOCTXT,R1 MOVBYT ;SET TABLE OF CONTENTS CALL SETSYM ;POINT TO ".SBTTL" 3$: GETR50 ;GET RADIX-50 CHAR BGT 3$ ;STOP AT FIRST TERMINATOR MOV CHRPNT,R2 ;SET POINTER .IF NDF XLCSEQ MOV LINNUM,R0 CALL 10$ MOVB #CH.SUB,-(R2) .IFF MOVB #TAB,-(R2) .ENDC MOV PAGNUM,R0 CALL 10$ MOVB #SPACE,-(R2) PUTLP R2 ;OUTPUT RETURN 10$: MOV #3,R4 11$: MOVB #SPACE,-(R2) MOV R0,R1 BEQ 12$ CLR R0 DIV #^D10,R0 ADD #DIG.0,R1 MOVB R1,(R2) 12$: SOB R4,11$ 13$: RETURN XITOVR ENTSEC TXTBYT TOCTXT: .ASCIZ /TABLE OF CONTENTS/ ENTSEC IMPPAS STLBUF: .BLKW <STLLEN+2>/2 ;SUB-TITLE BUFFER XITSEC SETOVR 3 IDENT: ;IDENT DIRECTIVE CALL RAD50 ;TREAT AS RAD50 CLR ROLUPD ;POINT TO START OF CODE-ROLL MOV #PRGIDN,R2 ; AND TO IDENT BLOCK 1$: NEXT CODROL ;GET NEXT ITEM MOV VALUE,(R2)+ ;STORE IT CMP R2,#PRGIDN+4 ;PROCESSED TWO WORDS? BLO 1$ ; NO .IF NDF XREL MOV #GSDT06,(R2)+ ;YES, SET GSD TYPE .ENDC ZAP CODROL ;CLEAR CODE ROLL RETURN XITOVR ENTSEC IMPURE PRGTTL: .BLKW 4 PRGIDN: .BLKW 4 ;IDENT BLOCK XITSEC .GLOBL PRINT, ERROR SETOVR 9 .ENABL LSB PRINT: ERROR <> ;NULL ERROR (DON'T COUNT) BR 1$ ERROR: ERROR P 1$: SETPF0 ;PRINT LOCATION FIELD EXPR ;EVALUATE EXPRESSION BEQ 2$ ;BRANCH IF NULL SETPF1 ;NON-NULL, LIST VALUE 2$: RETURN .DSABL LSB .IF NDF XBAW .GLOBL REM REM: ; ".REM" DIRECTIVE MOV R5,R3 ;SET TERMINATING CHARACTER BNE 1$ ;BRANCH IF NON-NULL ERROR A ;ERROR, NO DELIMITING CHARACTER RETURN 1$: GETCHR ;GET THE NEXT CHARACTER 2$: TST R5 ;END OF LINE? BNE 3$ ; NO CALL ENDLIN ;YES, POLISH OFF LINE CALL GETLIN ;GET NEXT LINE BEQ 2$ ;LOOP IF NO EOF RETURN ;EOF, EXIT 3$: CMP R5,R3 ;IS THIS THE TERMINATOR? BNE 1$ ; NO JMP GETNB ;YES, BYPASS AND EXIT .ENDC XITOVR .GLOBL BLKW, BLKB, EVEN, ODD, RADIX, EOT SETOVR 3 BLKW: INC R3 ;FLAG WORD TYPE BLKB: EXPR ;EVALUATE THE EXPRESSION BNE 1$ ;BRANCH IF NON-NULL INC (R4) ;NULL, MAKE IT ONE 1$: ABSTST ;MUST BE ABSOLUTE 2$: ADD R0,(R2) ;UPDATE PC ASR R3 ;WORD? BCS 2$ ; YES, DOUBLE VALUE RETURN EVEN: INC (R2) ;INCREMENT THE PC BIC #1,(R2) ;CLEAR IF NO CARRY RETURN ODD: BIS #1,(R2) ;SET LOW ORDER PC BYTE EOT: RETURN RADIX: MOV CRADIX,R2 ;SAVE IN CASE OF FAILURE MOV #10.,CRADIX EXPR ;* GET AN EXPRESSION [27-JUN-74 RRB] BEQ 3$ ;* NONE - REVERT TO OCTAL RADIX ABSTST ;* ELSE BE SURE IT'S ABSOLUTE CMP R0,#2. BLT 1$ CMP R0,#10. BLE 2$ 1$: ERROR A MOV R2,R0 2$: MOV R0,CRADIX JMP SETPF1 3$: MOV #8.,R0 ;* REVERT TO OCTAL RADIX [27-JUN-74 RRB] BR 2$ ;* AND EXIT ENTSEC IMPPAS ;IMPURE AREA CRADIX: .BLKW ;CURRENT RADIX ENTSEC XCTPAS ;TO BE EXECUTED EACH PASS MOV #8.,CRADIX ;INIT TO OCTAL RADIX XITSEC ;BACK TO NORMAL XITOVR .SBTTL DATA-GENERATING DIRECTIVES .GLOBL BYTE, WORD SETOVR 3 WORD: INC R3 ;"WORD" DIRECTIVE, SET TO 2 BYTE: INC R3 ;"BYTE" DIRECTIVE, SET TO 1 MOV (R2),-(SP) ;STACK CURRENT PC 1$: TSTARG ;TEST FOR ARGUMENT BEQ 2$ ; END EXPR ;PROCESS GENERAL EXPRESSION SETIMM ;CONVERT TO OBJECT FORMAT STCODE ;PUT ON CODE ROLL ADD R3,(R2) ;UPDATE PC BR 1$ ;TEST FOR MORE 2$: MOV (SP)+,(R2) ;RESTORE INITIAL PC DGTEST: TSTB ROLSIZ+CODROL+1 ;ANY CODE GENERATED? BNE 1$ ; YES CLR MODE ;NO, STORE A ZERO CLR VALUE SETIMM STCODE 1$: RETURN XITOVR .GLOBL RAD50, ASCII, ASCIZ SETOVR 3 ASCIZ: INC R3 ; ".ASCIZ", SET TO 1 ASCII: INC R3 ; ".ASCII", SET TO 0 RAD50: DEC R3 ; ".RAD50", SET TO -1 CALL 23$ ;INIT REGS 1$: MOV R5,R2 ;SET TERMINATOR BEQ 8$ ;ERROR IF EOL 2$: CMP R5,#CH.LAB ; "<", EXPRESSION? BEQ 10$ ; YES 3$: GETCHR ;NO, GET NEXT CHAR MOV R5,R0 ;SET IN WORK REGISTER BEQ 8$ ;ERROR IF EOL CMP R5,R2 ;TERMINATOR? BEQ 5$ ; YES TST R3 ;NO BMI 9$ ;BRANCH IF RAD50 .IF NDF XEDLC MOV CHRPNT,R0 ;FAKE FOR OVLAY PIC MOVB (R0),R0 ;FETCH POSSIBLE LOWER CASE BIC #177600,R0 ;CLEAR POSSIBLE SIGN BIT .ENDC BR 4$ 9$: TSTR50 ;TEST RADIX 50 4$: CALL 20$ ;PROCESS THE ITEM BR 3$ ;BACK FOR ANOTHER 5$: GETNB ;BYPASS TERMINATOR 6$: TSTB CTTBL(R5) ;EOL OR COMMENT? BGT 1$ ; NO BR 7$ 8$: ERROR A ;ERROR, FLAG AND EXIT 7$: CLR R0 ;YES, PREPARE TO CLEAN UP TST R3 ;TEST MODE BEQ 24$ ;NORMAL EXIT IF .ASCII BPL 20$ ;ONE ZERO BYTE IF .ASCIZ TST R1 ;.RAD50, ANYTHING IN PROGRESS? .IF NDF RSX11D BEQ DGTEST ; NO, NORMAL EXIT .IFF BEQ 24$ .ENDC CALL 20$ ;YES, PROCESS BR 6$ ;LOOP UNTIL WORD COMPLETED 10$: MOV (R4),-(SP) ;"<EXPRESSION>", SAVE PARTIAL ABSTRM ;ABSOLUTE TERM, SETTING R0 MOV (SP)+,(R4) ;RESTORE PARTIAL CALL 20$ ;PROCESS BYTE BR 6$ ;TEST FOR END 20$: TST R3 ;RAD50? BPL 22$ ; NO CMP R0,#50 ;YES, WITHIN RANGE? BLO 21$ ; YES ERROR T ;NO, ERROR 21$: MOV R0,-(SP) ;SAVE CURRENT CHAR MOV (R4),R0 ;GET PARTIAL CALL MULR50 ;MULTIPLY ADD (SP)+,R0 ;ADD IN CURRENT MOV R0,(R4) ;SAVE INC R1 ;BUMP COUNT CMP R1,#3 ;WORD COMPLETE? BNE 24$ ; NO 22$: MOV R0,(R4) ;STUFF IN VALUE SETIMM ;CONVERT TO OBJ MODE STCODE ;STOW IT 23$: CLR R1 ;CLEAR LOOP COUNT CLR (R4) ; AND VALUE 24$: RETURN XITOVR .IF NDF XFLTG .GLOBL FLT2, FLT4 SETOVR 3 FLT4: INC R3 FLT2: INC R3 ;MAKE IT 1 OR 2 ASL R3 ;NOW 2 OR 4 1$: TSTARG BEQ DGTEST MOV FLTPNT-2(R3),-(SP) ;EVALUATE NUMBER CALL @(SP)+ BNE 2$ ;BRANCH IF NON-NULL ERROR A ; NULL, FLAG ERROR 2$: MOV R3,R2 ;GET A WORKING COUNT MOV #FLTBUF,R1 ;POINT TO FLOATING POINT BUFFER 3$: MOV (R1)+,(R4) ;MOVE IN NEXT NUMBER STCODE ;PLACE ON CODE ROLL SOB R2,3$ ;LOOP ON WORD COUNT BR 1$ ;CONTINUE ENTSEC DPURE FLTPNT: .WORD FLTG2W, FLTG4W XITSEC .IF NDF XEDFPT GENEDT FPT,,1 ;FLOATING POINT TRUNCATION .ENDC XITOVR FLTG4W: INC FLTWDC ;FLOATING POINT NUMBER EVALUATOR FLTG2W: INC FLTWDC FLTG1W: ENTOVR 7 SAVREG ;SAVE REGISTERS MOV CHRPNT,-(SP) ;STACK CURRENT CHARACTER POINTER MOV #FLTBUF,R3 ;CONVENIENT COPY OF POINTERS MOV #FLTSAV,R4 ; TO BUFFER AND SAVE AREA MOV R4,R1 1$: CLR -(R1) ;INIT VARIABLES CMP R1,#FLTBEG BHI 1$ ;LOOP UNTIL DONE MOV #65.,FLTBEX ;INIT BINARY EXPONENT CMP #CH.ADD,R5 ; "+"? BEQ 10$ ; YES, BYPASS AND IGNORE CMP #CH.SUB,R5 ; "-"? BNE 11$ ; NO MOV #100000,FLTSGN ;YES, SET SIGN AND BYPASS CHAR 10$: GETCHR ;GET THE NEXT CHARACTER 11$: BITB #CT.NUM,CTTBL(R5) ;NUMERIC? BEQ 20$ ; NO BIT #174000,(R3) ;NUMERIC, ROOM FOR MULTIPLICATION? BEQ 12$ ; YES INC FLTEXP ;NO, COMPENSATE FOR THE SNUB BR 13$ 12$: CALL FLTM50 ;MULTIPLY BY 5 CALL FLTGLS ;CORRECTION, MAKE THAT *10 SUB #DIG.0,R5 ;MAKE ABSOLUTE MOV R4,R2 ;POINT TO END OF BUFFER ADD R5,-(R2) ;ADD IN ADC -(R2) ;RIPPLE CARRY ADC -(R2) ADC -(R2) 13$: ADD FLTDOT,FLTEXP ;DECREMENT IF PROCESSING FRACTION CLR (SP) ;CLEAR INITIAL CHAR POINTER (WE'RE GOOD) BR 10$ ;TRY FOR MORE 20$: CMP #CH.DOT,R5 ;DECIMAL POINT? BNE 21$ ; NO COM FLTDOT ;YES, MARK IT BMI 10$ ;LOOP IF FIRST TIME AROUND 21$: CMP #LET.E,R5 ;EXPONENT? BNE FLTG3 ; NO GETNB ;YES, BYPASS "E" AND BLANKS MOV CRADIX,-(SP) ;STACK CURRENT RADIX MOV #10.,CRADIX ;SET TO DECIMAL ABSTRM ;ABSOLUTE TERM MOV (SP)+,CRADIX ;RESTORE RADIX ADD R0,FLTEXP ;UPDATE EXPONENT ; BR FLTG3 ;FALL THROUGH FLTG3: MOV R3,R1 MOV (R1)+,R0 ;TEST FOR ZERO BIS (R1)+,R0 BIS (R1)+,R0 BIS (R1)+,R0 BEQ FLTGEX ;EXIT IF SO 31$: TST FLTEXP ;TIME TO SCALE BEQ FLTG5 ;FINI IF ZERO BLT 41$ ;DIVIDE IF .LT. ZERO CMP (R3),#031426 ;MULTIPLY, CAN WE *5? BHI 32$ ; NO CALL FLTM50 ;YES, MULTIPLY BY 5 INC FLTBEX ; AND BY TWO BR 33$ 32$: CALL FLTM54 ;MULTIPLY BY 5/4 ADD #3.,FLTBEX ; AND BY 8 33$: DEC FLTEXP ; OVER 10 BR 31$ 40$: DEC FLTBEX ;DIVISION, LEFT JUSTIFY BITS CALL FLTGLS 41$: TST (R3) ;SIGN BIT SET? BPL 40$ ; NO, LOOP MOV #16.*2,-(SP) ;16 OUTER, 2 INNER CALL FLTGRS ;SHIFT RIGHT CALL FLTGSV ;PLACE IN SAVE BUFFER 42$: BIT #1,(SP) ;ODD LAP? BNE 43$ ; YES CALL FLTGRS ;MOVE A COUPLE OF BITS RIGHT CALL FLTGRS 43$: CALL FLTGRS ;ONCE MORE TO THE RIGHT CALL FLTGAD ;ADD IN SAVE BUFFER DEC (SP) ;END OF LOOP? BGT 42$ ; NO TST (SP)+ ;YES, PRUNE STACK SUB #3.,FLTBEX INC FLTEXP BR 31$ FLTG5: DEC FLTBEX ;LEFT JUSTIFT CALL FLTGLS BCC FLTG5 ;LOSE ONE BIT ADD #200,FLTBEX ;SET EXCESS 128. BLE 2$ ;BRANCH IF UNDER-FLOW TSTB FLTBEX+1 ;HIGH ORDER ZERO? BEQ 3$ ; YES 2$: ERROR N ;NO, ERROR 3$: MOV R4,R2 ;SET TO SHIFT EIGHT BITS MOV R2,R1 TST -(R1) ;R1 IS ONE LOWER THAN R2 4$: CMP -(R1),-(R2) ;DOWN ONE WORD MOVB (R1),(R2) ;MOVE UP A BYTE SWAB (R2) ;BEWARE OF THE INSIDE-OUT PC!! CMP R2,R3 ;END? BNE 4$ CALL FLTGRS ;SHIFT ONE PLACE RIGHT ROR (R4) ;SET HIGH CARRY .IF NDF XEDFPT BIT #ED.FPT,EDMASK ;TRUNCATION? BEQ 7$ ; YES .ENDC MOV FLTWDC,R2 ;GET SIZE COUNT ASL R2 ;DOUBLE BNE 8$ ;PRESET TYPE INC R2 ;SINGLE WORD 8$: ASL R2 ;CONVERT TO BYTES BIS #077777,FLTBUF(R2) SEC 5$: ADC FLTBUF(R2) DEC R2 DEC R2 BGE 5$ TST (R3) ;TEST SIGN POSITION BPL 7$ ;OK IF POSITIVE 6$: ERROR T 7$: ADD FLTSGN,(R3) ;SET SIGN, IF ANY FLTGEX: CLR MODE ;MAKE ABSOLUTE CLR FLTWDC ;CLEAR COUNT MOV (R3),VALUE ;PLACE FIRST GUY IN VALUE MOV (SP)+,R0 ;ORIGIONAL CHAR POINTER BEQ 1$ ;ZERO (GOOD) IF ANY DIGITS PROCESSED MOV R0,CHRPNT ;NONE, RESET TO WHERE WE CAME IN CLR R3 ;FLAG AS FALSE 1$: MOV R3,R0 ;SET FLAG IN R0 JMP SETNB ;RETURN WITH NON-BLANK FLTM54: ;*5/4 CMP (R3),#146314 ;ROOM? BLO 1$ CALL FLTGRS INC FLTBEX 1$: CALL FLTGSV ;SAVE IN BACKUP CALL FLTGRS ;SCALE RIGHT CALL FLTGRS BR FLTGAD FLTM50: ;*5 CALL FLTGSV CALL FLTGLS CALL FLTGLS FLTGAD: ;ADD SAVE BUFFER TO FLTBUF MOV R4,R2 ;POINT TO SAVE AREA 1$: ADD 6(R2),-(R2) ;ADD IN WORD MOV R2,R1 ;SET FOR CARRIES 2$: ADC -(R1) ;ADD IN BCS 2$ ;CONTINUE RIPPLE, IF NECESSARY CMP R2,R3 ;THROUGH? BNE 1$ ; NO RETURN FLTGRS: CLC ;RIGHT SHIFT MOV R3,R1 ;RIGHT ROTATE ROR (R1)+ ROR (R1)+ ROR (R1)+ ROR (R1)+ RETURN FLTGLS: ;LEFT SHIFT MOV R4,R2 ASL -(R2) ROL -(R2) ROL -(R2) ROL -(R2) RETURN FLTGSV: MOV R3,R1 ;MOVE FLTBUF TO FLTSAV MOV R4,R2 JMP XMIT4 ENTSEC IMPURE FLTBEG: ;START OF FLOATING POINT IMPURE FLTSGN: .BLKW ;SIGN BIT FLTDOT: .BLKW ;DECIMAL POINT FLAG FLTEXP: .BLKW ;DECIMAL EXPONENT FLTBEX: .BLKW 1 ;BINARY EXPONENT (MUST PRECEED FLTBUF) FLTBUF: .BLKW 4 ;MAIN AC FLTSAV: .BLKW 4 ENTSEC IMPLIN FLTWDC: .BLKW ;WORD COUNT XITSEC XITOVR .ENDC .SBTTL CONDITIONALS .GLOBL IIF SETOVR 5 IIF: ;IMMEDIATE HANDLERS CALL TCON ;TEST ARGUMENT TST R3 BMI 3$ ; BRANCH IF UNSATISFIED CMP #CH.COM,R5 ;COMMA? BNE 1$ ; NO GETCHR ;YES, BYPASS 1$: MOV CHRPNT,R1 ;SAVE CURRENT LOCATION SETNB ;SET TO NOM-BLANK BIT #LC.CND,LCMASK ;CONDITIONAL SUPPRESSION? BEQ 2$ ; NO MOV R1,LCBEGL ;YES, SUPPRESS ALL UP TO COMMA 2$: CLR ARGCNT JMP STMNT ;BACK TO STATEMENT 3$: CLR R5 ;FALSE, BUT NO "Q" ERROR BR ENDCX ;CONCATENATED CONDITIONALS .IRP ARG, <EQ,GE,GT,LE,LT,NE,G,L,NZ,Z,DF,NDF> .GLOBL IF'ARG IF'ARG: .ENDM MOV SYMBOL+2,SYMBOL ;TREAT SECOND HALF AS ARGUMENT CALL TCONF ;EXAMINE IT BR IF1 ;INTO THE MAIN STREAM .GLOBL IF, IFT, IFF, IFTF, ENDC IF: ;MICRO-PROGRAMMMED CONDITIONAL CALL TCON ;TEST ARGUMENT IF1: MOV #CNDLVL,R1 ;POINT TO LEVEL CMP (R1),#15. ;ROOM FOR ANOTHER? BGT IFOERR ; NO, ERROR INC (R1) ;YES, BUMP LEVEL ASL R3 ;SET CARRY TO TRUE (0) OR FALSE (1) ROR -(R1) ;ROTATE INTO CNDMSK ASL R3 ROR -(R1) ;DITTO FOR CNDWRD BR ENDCX IFT: ;IF TRUE SUB-CONDITIONAL MOV CNDMSK,R3 ;GET CURRENT BR IFTF ; AND BRANCH IFF: ;IF FALSE SUB-CONDITIONAL MOV CNDMSK,R3 ;GET CURRENT CONDITION COM R3 ;USE COMPLEMENT AND FALL THROUGH IFTF: ;UNCONDITIONAL SUB-CONDITIONAL ;(R3=0 WHEN CALLED DIRECTLY) TST CNDLVL ;CONDITIONAL IN PROGRESS? BLE IFOERR ; NO, ERROR ASL CNDWRD ;MOVE OFF CURRENT FLAG ASL R3 ;SET CARRY ROR CNDWRD ;MOV ON BR ENDCX ENDC: ;END OF CONDITIONAL MOV #CNDLVL,R1 ;POINT TO LEVEL TST (R1) ;IN CONDITIONAL? BLE IFOERR ; NO, ERROR DEC (R1) ;YES, DECREMENT ASL -(R1) ;REDUCE MASK ASL -(R1) ; AND TEST WORD ENDCX: BIT #LC.CND,LCMASK ;SUPPRESSION REQUESTED? BEQ 2$ ; NO MOV LBLEND,R0 ;YES, ANY LABEL? BEQ 1$ ; NO, SUPPRESS WHOLE LINE MOV R0,LCENDL ;YES, LIST ONLY LABEL BR 2$ 1$: BIS #LC.CND,LCFLAG ;MARK CONDITIONAL 2$: RETURN IFOERR: ERROR O ;CONDITION ERROR RETURN TCON: ;TEST CONDITION GSARG ;GET A SYMBOL TCONF: SCANW CNDROL ;SCAN FOR ARGUMENT BEQ IFAERR ; ERROR IF NOT FOUND MOV SYMBOL+2,R1 ;GET ADDRESS ASR R1 ;LOW BIT USED FOR TOGGLE FLAG SBC R3 ;R3 GOES TO -1 IF ODD ASL R1 ;BACK TO NORMAL (AND EVEN) TST CNDWRD ;ALREADY UNSAT? BNE IFAERX ; YES, JUST EXIT TSTARG ;BYPASS COMMA JMPOVR R1 ;JUMP TO HANDLER IFAERR: ERROR A IFAERX: CLR R5 ;NO "Q" ERROR RETURN XITOVR GENCND EQ, TCONEQ GENCND NE, TCONEQ, F GENCND Z, TCONEQ GENCND NZ, TCONEQ, F GENCND GT, TCONGT GENCND LE, TCONGT, F GENCND G, TCONGT GENCND LT, TCONLT GENCND GE, TCONLT, F GENCND L, TCONLT GENCND DF, TCONDF GENCND NDF, TCONDF, F .IF DF XMACRO GENCND B, TCONB GENCND NB, TCONB, F .ENDC SETOVR 5 .IF DF XMACRO TCONB: BEQ TCONTR ;TRUE IF NULL CLR R5 ;SUPRESS Q ERROR IF NOT NULL BR TCONFA .ENDC TCONEQ: ABSEXP ;EQ/NE, TEST EXPRESSION BEQ TCONTR ;BRANCH IF SAT TCONFA: COM R3 ; FALSE, TOGGLE TCONTR: RETURN ;TRUE, JUST EXIT TCONGT: ABSEXP BGT TCONTR BR TCONFA TCONLT: ABSEXP BLT TCONTR BR TCONFA TCONDF: ;IF/IDF MOV R3,R1 ;SAVE INITIAL CONDITION CLR R2 ;SET "&" CLR R3 ;START OFF TRUE 1$: GETSYM ;GET A SYMBOL BEQ IFAERR ; ERROR IF NOT A SYM SSRCH ;SEARCH USER SYMBOL TABLE CRFREF CLR R0 ;ASSUME DEFINED BIT #DEFFLG,MODE ;GOOD GUESS? BNE 2$ ; YES COM R0 ;NO, TOGGLE 2$: CMP R0,R3 ;YES, MATCH? BEQ 3$ ; YES, ALL SET MOV R2,R3 ; NO COM R3 3$: MOV R1,R2 ;ASSUME "&" CMP R5,#CH.AND ; "&" BEQ 4$ ; BRANCH IF GOOD GUESS CMP R5,#CH.IOR ;PERHAPS OR? BNE 5$ ; NO COM R2 ;YES, TOGGLE MODE 4$: GETNB ;BYPASS OP BR 1$ ;TRY AGAIN 5$: TST R1 ;IFDF? BEQ 6$ ; YES COM R3 ;NO, TOGGLE 6$: RETURN ENTSEC IMPPAS ;CONDITIONAL STORAGE (MUST BE ORDERED) CNDWRD: .BLKW ;TEST WORD CNDMSK: .BLKW ;CONDITION MASK CNDLVL: .BLKW ;NESTING LEVEL CNDMEX: .BLKW ;MEXIT FLAG XITSEC XITOVR .SBTTL LISTING CONTROL .GLOBL NLIST, LIST SETOVR 2 .ENABL LSB NLIST: COM R3 ;MAKE R3 -1 LIST: ASL R3 ;MAKE R3 0/-2 INC R3 ;NOW 1/-1 1$: TSTARG ;TEST FOR ANOTHER ARGUMENT BNE 2$ ; VALID TST ARGCNT ;NULL, FIRST? BNE 7$ ; NO, WE'RE THROUGH INC ARGCNT ;YES, MARK IT 2$: GETSYM ;TRY FOR A SYMBOL $NLIST: SCANW LCDROL ;LOOK IT UP IN THE TABLE BEQ 6$ ; ERROR IF NOT FOUND CLR R2 SEC 3$: ROL R2 SOB R0,3$ TST EXMFLG ;CALLED FROM COMMAND STRING? BEQ 11$ ; NO BIS R2,LCMCSI ;YES, SET DISABLE BITS BR 12$ ; AND SKIP TEST 11$: BIT R2,LCMCSI ;THIS FLAG OFF LIMITS? BNE 5$ ; YES 12$: BIC R2,LCMASK BIT R2,#LC. ;NULL? BEQ 4$ ; NO CALL PAGEX ;SET LISTING CONTROL ADD R3,LCLVL ;YES, UPDATE LEVEL COUNT BEQ 5$ ;DON'T SET FLAG IF BACK TO ZERO 4$: TST R3 BPL 5$ ;.LIST, BRANCH BIS R2,LCMASK 5$: BR 1$ ;TRY FOR MORE 6$: ERROR A 7$: RETURN .DSABL LSB ; GENSWT LI,LIST ;GENERATE /LI ; GENSWT NL,NLIST ; AND /NL SWITCH ENTRIES .GLOBL PAGE PAGE: INC FFCNT ;SIMULATE FF AFTER THIS LINE PAGEX: BIS #LC.LD,LCFLAG ;FLAG AS LISTING DIRECTIVE RETURN XITOVR .MACRO GENLCT MNE,INIT ;GENERATE LISTING CONTROL TABLE LC.'MNE= 1 .REPT <.-LCTBAS>/2 LC.'MNE= LC.'MNE+LC.'MNE .ENDR .GLOBL LC.'MNE .RAD50 /MNE/ .IF NB <INIT> LCINIT= LCINIT+LC.'MNE .ENDC .ENDM LCINIT= 0 ENTSEC DPURE LCTBAS: GENLCT SEQ GENLCT LOC GENLCT BIN GENLCT SRC GENLCT COM GENLCT BEX GENLCT MD GENLCT MC GENLCT ME ,1 GENLCT MEB,1 GENLCT CND GENLCT LD ,1 .IF NDF RSX11D GENLCT TTM .IFF GENLCT TTM,1 .ENDC GENLCT TOC GENLCT SYM GENLCT < > ;NULL LCTTOP: ENTSEC IMPURE LCSAVE: ;LISTING CONTROL SAVE BLOCK LCMASK: .BLKW ;MASK BITS LCLVL: .BLKW ;LEVEL COUNT LCMCSI: .BLKW ;COMMAND STRING STORAGE LCSAVL= .-LCSAVE LCSBAK: .BLKW LCSAVL/2 ;FOR INITTING PASS 2 ENTSEC IMPLIN LCFLAG: .BLKW ;FLAG BITS LCBEGL: .BLKW ;POINTER TO START OF LINE LCENDL: .BLKW ;POINTER TO END OF LINE LBLEND: .BLKW ;END OF LABEL (FOR PARSING) ENTSEC XCTPRG .GLOBL LCBITS .BLKW 1 LCBITS: .BLKW -1 MOV #LCINIT,LCSBAK+<LCMASK-LCSAVE> ;DEFAULT FLAGS ENTSEC XCTPAS ;EXECUTE THIS CODE EACH PASS MOV #LCSBAK,R1 ;RESET LISTING FLAGS MOV #LCSAVE,R2 XMIT LCSAVL/2 XITSEC MACP0: ;SAVE OUTPUT SWITCHES MOV #LCSAVE,R1 ;REVERSE OF ABOVE MOV #LCSBAK,R2 XMIT LCSAVL/2 MOV EDMASK,EDMBAK ;DITTO FOR ENABL/DSABL RETURN .SBTTL ENABL/DSABL FUNCTIONS .GLOBL ENABL, DSABL SETOVR 2 .ENABL LSB DSABL: COM R3 ;R3=-1 ENABL: ;R3=0 1$: GSARG ;GET A SYMBOLIC ARGUMENT BEQ 8$ ;END IF NULL $EDABL: SCANW EDTROL ;SEARCH THE TABLE BEQ 7$ ; NOT THERE, ERROR CLR R2 ;COMPUTE BIT POSITION SEC 2$: ROL R2 SOB R0,2$ TST EXMFLG ;CALLED FROM COMMAND STRING? BEQ 3$ ; NO BIS R2,EDMCSI ;YES, SET DISABLE BITS BR 4$ ; AND BYPASS TEST 3$: BIT R2,EDMCSI ;OVER-RIDDEN FROM CSI? BNE 1$ ; YES, IGNORE IT 4$: BIC R2,EDMASK ;NO, CLEAR SELECTED BIT TST R3 ;ENDBLE? BEQ 5$ ; YES, LEAVE IT CLEAR BIS R2,EDMASK ;NO, CLEAR IT 5$: MOV SYMBOL+2,-(SP) ;MAKE IT PIC TST R3 ;SET FLAGS CALL @(SP)+ ;CALL ROUTINE BR 1$ 7$: ERROR A 8$: RETURN .DSABL LSB XITOVR ENTSEC IMPURE EDMASK: .BLKW ;CONTAINS SET FLAGS EDMCSI: .BLKW ;BITS FOR CSI OVERRIDE EDMBAK: .BLKW ;TO RE-INIT FOR PASS 2 ENTSEC XCTPRG .GLOBL EDBITS .BLKW 1 EDBITS: .BLKW -1 MOV #EDINIT,EDMBAK ;SET DEFAULT CONDITIONS ENTSEC XCTPAS MOV EDMBAK,EDMASK ;SET EACH PASS XITSEC ; GENSWT EN,ENABL ;GENERATE /EN ; GENSWT DS,DSABL ; AND /DS SWITCH TABLE ENTRIES .SBTTL LISTING STUFF SETPF0: ;SET PRINT FIELD ZERO MOV CLCFGS,PF0 ;SET CURRENT LOCATION FLAGS BISB #100,PF0+1 ;ASSUME WORD MOV CLCLOC,PF0+2 ;SET LOCATION RETURN SETPF1: ;SET PRINT FIELD ONE MOV MODE,PF1 ;SET MODE OF CURRENT VALUE BISB #100,PF1+1 ;ASSUME WORD MOV VALUE,PF1+2 RETURN ENTSEC IMPLIN PF0: .BLKW 2 PF1: .BLKW 2 XITSEC SETWDB: ;SET WORD OR BYTE TST (R1) ;POSITIVE? BMI SETBYT ; NO, BYTE SETWRD: MOV R1,-(SP) ;STACK REG MOV 2(R1),R1 ;GET ACTUAL VALUE MOVB #DIG.0/2,(R2) ;SET PRIMITIVE ASL R1 ROLB (R2)+ ;MOVE IN BIT MOV #5,R0 BR SETBYX SETBYT: MOV R1,-(SP) ;STACK INDEX MOVB 2(R1),R1 ;GET VALUE MOV #SPACE,R0 MOVB R0,(R2)+ ;PAD WITH SPACES MOVB R0,(R2)+ MOVB R0,(R2)+ SWAB R1 ;MANIPULATE TO LEFT HALF RORB R1 ;GET THE LAST GUY CLC ROR R1 MOV #3,R0 SETBYX: SWAB R0 ADD #3,R0 MOVB #DIG.0/10,(R2) 1$: ASL R1 ROLB (R2) DECB R0 BGT 1$ TSTB (R2)+ SWAB R0 SOB R0,SETBYX MOV (SP)+,R1 RETURN .SBTTL OBJECT CODE HANDLERS ENDP1: ;END OF PASS HANDLER ENTOVR 4 .IF NDF XREL CALL SETMAX ;SET MAX LOCATION .IFTF TSTB IOFTBL+BINCHN ;ANY OBJ FILE? BEQ ENDP1B ; NO CALL OBJINI ;INIT OUTPUT .IFT MOV #BLKT01,@BUFTBL+RELCHN ;SET BLOCK TYPE 1 MOV #PRGTTL,R1 ;SET "FROM" INDEX CALL GSDDMP ;OUTPUT GSD BLOCK .IF NDF DOSV4 MOV #PRGIDN,R1 ;POINT TO SUB-TTL BUFFER TST 4(R1) ;SET? BEQ 9$ ; NO CALL GSDDMP ;YES, STUFF IT .ENDC 9$: CLR -(SP) ;INIT FOR SECTOR SCAN 10$: MOV (SP)+,ROLUPD ;SET SCAN MARKER NEXT SECROL ;GET THE NEXT SECTOR BEQ ENDP1A ;BRANCH IF THROUGH MOV ROLUPD,-(SP) ;SAVE MARKER .IF NDF RSX11D MOV #MODE,R1 MOV (R1),R5 ;SAVE SECTOR CLRB R5 ;ISOLATE IT SWAB R5 ; AND PLACE IN RIGHT BIC #^C<RELFLG>,(R1) ;CLEAR ALL BUT REL BIT BIS #<GSDT01>+DEFFLG,(R1)+ ;SET TO TYPE 1, DEFINED MOV R5,(R1)+ ;ASSUME ABS .IFF MOV #SECTOR,R1 CLR R5 BISB (R1),R5 MOVB #GSDT05/400,(R1)+ CLR (R1)+ BITB #CSTREL,MODE .ENDC .IF NDF RT11 BEQ 11$ ; OOPS! .ENDC MOV (R1),-(R1) ; REL, SET MAX 11$: CLR ROLUPD ;SET FOR INNER SCAN 12$: MOV #SYMBOL,R1 CALL GSDDMP ;OUTPUT THIS BLOCK 13$: NEXT SYMROL ;FETCH THE NEXT SYMBOL BEQ 10$ ; FINISHED WITH THIS GUY BIT #GLBFLG,MODE ;GLOBAL? BEQ 13$ ; NO CMPB SECTOR,R5 ;YES, PROPER SECTOR? BNE 13$ ; NO BIC #^C<DEFFLG!RELFLG!GLBFLG>,MODE ;CLEAR MOST BIS #GSDT04,MODE ;SET TYPE 4 BR 12$ ;OUTPUT IT ENDP1A: BIC #^C<RELFLG>,ENDVEC+4 ;CLEAR ALL BUT REL FLAG BIS #GSDT03+DEFFLG,ENDVEC+4 MOV #ENDVEC,R1 CALL GSDDMP ;OUTPUT END BLOCK CALL OBJDMP ;DUMP IT MOV #BLKT02,@BUFTBL+RELCHN ;SET "END OF GSD" CALL RLDDMP MOV #BLKT04,@BUFTBL+RELCHN ;INIT FOR TEXT BLOCKS .IFTF ENDP1B: .IFT CLR ROLUPD ;SET FOR RE-INIT SCAN 31$: NEXT SECROL ;GET THE NEXT ENTRY BEQ 32$ ; BRANCH IF FINISHED CLR VALUE ;FOUND, RESET PC INSERT ;PUT BACK IN TABLE BR 31$ 32$: .IFTF INC PASS ;SET FOR PASS 2 RETURN .IFT GSDDMP: ;DUMP A GSD BLOCK MOV #4*2,R0 ;FOUR WORDS PER GSD ENTRY CALL TSTRLD ;ROOM? JMP XMIT4 ;WE HAVE NOW. STUFF ENTRY .ENDC XITOVR ENDP2: ;END OF PASS 2 ENTOVR 4 .IF NDF XREL CALL SETMAX ;SET MAX LOCATION .IFTF MOV #SYMTXT,R1 MOV #STLBUF,R2 MOVBYT ;SET "SYMBOL TABLE" SUB-TITLE TST OBJPNT ;ANY OBJECT OUTPUT? BEQ 1$ ; NO CALL OBJDMP ;YES, DUMP IT .IFT MOV #BLKT06,@BUFTBL+RELCHN ;SET END CALL RLDDMP ;DUMP IT .ENDC .IF NDF XEDABS BIT #ED.ABS,EDMASK ;ABS OUTPUT? BNE 1$ ; NO MOV OBJPNT,R0 MOV ENDVEC+6,(R0)+ ;SET END VECTOR MOV R0,OBJPNT CALL OBJDMP .ENDC 1$: TSTB LSTDEV ;ANY LISTING OUTPUT? BEQ ENDP2D ; NO BIT #LC.SYM,LCMASK ;SYMBOL TABLE SUPPRESSION? BNE ENDP2D ; YES CLR LPPCNT ;FORCE NEW PAGE CLR ROLUPD ;SET FOR SYMBOL TABLE SCAN 2$: MOV #LINBUF,R2 ;POINT TO STORAGE MOV #3,SYMCNT ;DEFAULT # OF COLUMNS .IF NDF XLCTTM BIT #LC.TTM,LCMASK ;LINE PRINTER MODE? BEQ 3$ ;NOPE MOV #5,SYMCNT ;ELSE USE 5 COLUMNS .ENDC 3$: NEXT SYMROL ;GET THE NEXT SYMBOL BEQ ENDP2A ; NO MORE R50UNP ;UNPACK THE SYMBOL MOV #ENDP2T,R3 CALL ENDP2C MOV #MODE,R1 ;POINT TO MODE BITS BIT #DEFFLG,(R1) ;DEFINED? BEQ 4$ ; NO CALL SETWRD BR 6$ 4$: MOV #STARS,R1 MOVBYT ;UNDEFINED, SUBSTITUTE ****** 6$: CALL ENDP2C .IIF DF RSX11D, CALL ENDP2X MOV #SECTOR,R1 CMPB #1,(R1) BGE 10$ CMPB -(R1),-(R1) CALL SETBYT 10$: MOVB #TAB,(R2)+ ;SEPARATOR DEC SYMCNT ;ANY LEFT ON THIS LINE? BNE 3$ ;YES 11$: CALL ENDP2B ;OUTPUT LINE BR 2$ ;NEXT LINE ENTSEC IMPURE SYMCNT: .WORD 0 XITSEC ENDP2A: .IF NDF XREL CLR ROLUPD ;SET FOR SECTOR SCAN 21$: CALL ENDP2B ;OUTPUT LINE NEXT SECROL ;GET THE NEXT ENTRY BEQ ENDP2D ; EXIT IF END OF ROLL R50UNP ;PRINT THE NAME, MOVB #TAB,(R2)+ MOV #VALUE,R1 CALL SETWRD ; THE VALUE, MOVB #TAB,(R2)+ MOV #SECTOR-2,R1 CALL SETBYT ; AND THE ENTRY NUMBER BR 21$ .IFF RETURN .ENDC ENDP2B: CLRB (R2) PUTLP #LINBUF MOV #LINBUF,R2 ;RESET TO START OF BUFFER ENDP2D: RETURN ENDP2C: CALL ENDP2X ENDP2X: MOV (R3)+,R0 BIT (R3)+,MODE BNE 32$ SWAB R0 32$: MOVB R0,(R2)+ RETURN ENTSEC DPURE ENDP2T: .ASCII / =/ .WORD LBLFLG .ASCII /% / .WORD REGFLG .ASCII /R / .WORD RELFLG .ASCII /G / .WORD GLBFLG .IF DF RSX11D .ASCII /X / .WORD DFGFLG .ENDC ENTSEC TXTBYT STARS: .ASCIZ /******/ SYMTXT: .ASCIZ /SYMBOL TABLE/ XITSEC XITOVR .SBTTL CODE ROLL HANDLERS STCODE: APPEND CODROL ;APPEND TO CODROL RETURN PCROLL: ;PROCESS CODE ROLL NEXT CODROL ;GET NEXT CODE ROLL ENTRY BEQ PCROL3 ; END SAVREG CLR R5 ;ASSUME BYTE CLR R4 BISB SECTOR,R4 ;GET THE RLD TYPE BMI 1$ ;BRANCH IF BYTE INC R5 ; WORD, BUMP TO 1 1$: TST PASS ;PASS ONE? BEQ PCROL2 ; YES, JUST UPDATE PC INC PCRCNT ;EXTENSION LINE? BMI 2$ ; YES SETPF0 ;LIST COLUMN ZERO 2$: SETPF1 ;SET PRINT FIELD ONE ASLB R4 ;BYTE? TST OBJPNT ;ANY OBJECT CODE CALLED FOR? BEQ PCROL2 ; NO .IF NDF XEDPNC BIT #ED.PNC,EDMASK ;PUNCH DISABLED? BNE PCROL2 ; YES .ENDC .IF NDF XREL MOV PCRTBL(R4),R4 ;GET PROPER TABLE ENTRY CMPB CLCSEC,OBJSEC ;SECTOR CHANGE? BEQ 10$ ; NO MOV #4*2,R0 CALL TSTRLD ;SOFTEN UP RLD BUFFER MOV #RLDT07,(R2)+ ;SET RLD TYPE 7 MOV CLCNAM,(R2)+ ; AND NEW SECTOR NAME MOV CLCNAM+2,(R2)+ MOVB CLCSEC,OBJSEC BR 12$ .IFTF 10$: CMP CLCLOC,OBJLOC ;DID PC MOVE ON US? BEQ 14$ ; NO .IFT MOV #2*2,R0 CALL TSTRLD ;MAKE ROOM MOV #RLDT10,(R2)+ 12$: .IFTF MOV CLCLOC,(R2) ;SET NEW PC .IF DF YPHASE SUB PHAOFF,(R2) .ENDC 13$: CALL OBJDMP ;DUMP BUFFER 14$: MOV OBJPNT,R0 ;GET CODE POINTER ADD R5,R0 ;COMPUTE NEW END SUB BUFTBL+BINCHN,R0 CMP R0,#OBJLEN-1 ;ROOM? BHI 13$ ; NO .IFT MOVB R4,R0 ;YES, GET RLD SIZE CALL TSTRLD ;BE SURE WE HAVE ROOM .IFTF MOV OBJPNT,R1 CMP R1,BUFTBL+BINCHN ;FIRST ITEM? BNE 16$ ; NO .IFT .IF NDF XEDABS BIT #ED.ABS,EDMASK ;ABS OUTPUT? BEQ 15$ ; YES .ENDC MOV #BLKT03,(R1)+ ;NO, SET BLOCK TYPE .IFTF 15$: MOV CLCLOC,(R1)+ ; AND STARTING ADDRESS .IIF DF YPHASE, SUB PHAOFF,-2(R1) 16$: .IFT ASL R4 ;ANY RLD? BCC PCROL1 ; NO MOVB SECTOR,(R2)+ ;YES, SET CODE MOV R1,R0 SUB BUFTBL+BINCHN,R0 ;COMPUTE INDEX MOVB R0,(R2)+ PCROL1: ASL R4 ;ANY SYMBOL REQUESTED? BCC 21$ ; NO MOV SYMBOL,(R2)+ ;YES, MOVE IT MOV SYMBOL+2,(R2)+ 21$: ASL R4 ;ANY VALUE? BCC 22$ ; NO MOV VALUE,(R2)+ ;YES, MOVE IT 22$: .ENDC MOVB VALUE,(R1)+ TST R5 BEQ 29$ ;BRANCH IF BYTE INSTRUCTION MOVB VALUE+1,(R1)+ 29$: MOV R1,OBJPNT PCROL2: INC R5 ;MAKE COUNT 1 OR 2 ADD R5,CLCLOC ;UPDATE PC MOV CLCLOC,OBJLOC ;SET SEQUENCE BREAK SETNZ R0 ;SET TRUE RETURN PCROL3: RETURN ENTSEC IMPLIN PCRCNT: .BLKW ;EXTENSION LINE FLAG XITSEC .IF NDF XREL ENTSEC DPURE PCRTBL: ;TABLE BY RLD TYPE .WORD 0 .WORD 120004 ;RLDT01 .WORD 140006 ;RLDT02 .WORD 120004 ;RLDT03 .WORD 140006 ;RLDT04 .WORD 160010 ;RLDT05 .WORD 160010 ;RLDT06 .WORD 0 .WORD 0 .WORD 100002 ;RLDT11 .WORD 0 .WORD 0 .WORD 0 .WORD 160010 ;RLDT15 .WORD 160010 ;RLDT16 .ENDC ENTSEC IMPPAS .ODD OBJSEC: .BLKB 1 ;OBJECT FILE SECTOR OBJLOC: .BLKW 1 ;OBJECT FILE LOCATION ENTSEC XCTPAS ;EXECUTE EACH PASS COMB OBJSEC ;FORCE SEQUENCE BREAK XITSEC .IF NDF XEDPNC GENEDT PNC,PNCSET ;PUNCH CONTROL PNCSET: MOVB #377,OBJSEC ;FORCE SEQUENCE BREAK RETURN .ENDC OBJDMP: ;DUMP THE OBJECT BUFFER MOV OBJPNT,@CNTTBL+BINCHN ;POINTER TO COUNT SLOT BEQ OBJINX ;EXIT IF NOT PRE-SET SUB BUFTBL+BINCHN,@CNTTBL+BINCHN ;COMPUTE ACTUAL COUNT BEQ 1$ ; EMPTY, FORGET IT $WRITW BIN ;WRITE IT OUT AND WAIT 1$: .IF NDF XREL MOV BUFTBL+RELCHN,R0 TST (R0)+ ;IGNORE FIRST WORD CMP RLDPNT,R0 ;ANYTHING IN RLD? BLOS OBJINI ; NO, JUST INIT RLDDMP: .IF NDF XEDABS BIT #ED.ABS,EDMASK ;ABS OUTPUT? BEQ OBJINI ; YES, NO RLD .ENDC MOV RLDPNT,@CNTTBL+RELCHN SUB BUFTBL+RELCHN,@CNTTBL+RELCHN ;COMPUTE BYTE COUNT $WRITW REL .IFTF OBJINI: MOV BUFTBL+BINCHN,OBJPNT .IFT MOV BUFTBL+RELCHN,RLDPNT ADD #2,RLDPNT ;RESERVE WORD FOR BLOCK TYPE .IFTF OBJINX: RETURN .IFT TSTRLD: ;TEST AND SOFTEN RLD BUFFER MOV R0,-(SP) ;SAVE BYTE COUNT ADD RLDPNT,R0 SUB BUFTBL+RELCHN,R0 CMP R0,#RLDLEN ;ROOM TO STORE? BLOS 1$ ; YES CALL OBJDMP ;NO, DUMP CURRENT 1$: MOV RLDPNT,R2 ;RETURN WITH POINTER IN R2 ADD (SP)+,RLDPNT ;UPDATE POINTER RETURN .IFTF ENTSEC IMPURE OBJPNT: .BLKW .IFT RLDPNT: .BLKW .ENDC XITSEC LST.KB= 1 ;TELETYPE LISTING LST.LP= 2 ;LPT LISTING PUTKB: MOV #LST.KB,LSTREQ ;SET REQUEST BR PUTLIN PUTKBL: MOV #LST.KB,LSTREQ ;SET FOR TTY PUTLP: BISB LSTDEV,LSTREQ ;LPT PUTLIN: ;OUTPUT A LINE SAVREG ;STACK REGISTERS MOV R0,R1 ;ARG TO R1 MOVB LSTREQ,R4 ;GET REQUEST CLR LSTREQ ;CLEAR IT TST R4 BEQ PUTLI9 ;JUST EXIT IF EMPTY BGT PUTLI2 ;OMIT HEADER IF NOT LISTING DEC LPPCNT ;YES, DECREMENT COUNT BGT PUTLI2 ;SKIP IF NOT TIME ENTOVR 8 PUTLI1: MOV #LPP,LPPCNT ;RESET COUNT MOV R1,-(SP) ;STACK CURRENT POINTER TST PASS BEQ 12$ MOV TTLBRK,R2 ;END OF PRE-SET TITLE MOV #PAGMNE,R1 MOVBYT ;MOVE "PAGE" INTO POSITION MOV PAGNUM,R1 DNC ;CONVERT TO DECIMAL INC PAGEXT BEQ 11$ MOVB #CH.ADD,(R2)+ 11$: CLRB (R2) 12$: PUTLP #TTLBUF ;PRINT TITLE PUTLP #STLBUF ; SUB-TITLE, PUTLP #CRLF ; AND A BLANK LINE MOV (SP)+,R1 XITOVR INLINE ;FALL THROUGH PUTLI2: $WAIT LST ;WAIT ON PREVIOUS OUTPUT MOV BUFTBL+LSTCHN,R2 ;SET DESTINATION INDEX MOV R2,R3 ;SAVE A COPY 21$: MOVB (R1)+,(R2)+ ;MOVE CHARACTER TO OUTPUT BUFFER BGT 21$ ;LOOP IF NOTHING SPECIAL MOVB -(R2),R0 ;SPECIAL, BACK UP AND SET R0 BEQ 22$ ;END IF NULL .IF NDF XEDLC BICB #200,-(R1) ;CLEAR SIGN BIT IN SOURCE BNE 21$ ;RE-STORE IF LOWER CASE MOVB #CH.QM,(R1) ;MUST BE ERROR .IFF MOVB #CH.QM,-(R1) ;ILLEGAL CHAR, SET "?" .ENDC BR 21$ 22$: CMP R2,R3 ;AT BEGINNING? BEQ 24$ ; YES, DON'T RETREAT MOVB -(R2),R0 ;FETCH PRECEDING CHAR BITB #CT.SP!CT.TAB,CTTBL(R0) ;BLANK? BNE 22$ ; YES, TRIM IT CMPB #VT,(R2)+ ;MOVE TO END, A VT? BEQ 23$ ; YES, NO CR/LF 24$: MOVB #CR,(R2)+ ;STUFF CR MOVB #LF,(R2)+ ;SET LF 23$: SUB R3,R2 ;COMPUTE CHARACTER COUNT MOV R2,@CNTTBL+LSTCHN ;SET COUNT ASR R4 ;KB REQUESTED? BCC 25$ ; NO .IF NDF RT11 $WRITW CMO ;TYPE THE LINE .IFF ADD R3,R2 CLRB -(R2) ;SET STOPPER MOV BUFTBL+LSTCHN,R0 EMT 340+11 ; LINES TYPED HERE SHOULD NOT BE LISTED BELOW .ENDC 25$: ASR R4 ;LISTING REQUESTED? BCC PUTLI9 ; NO $WRITE LST ;LIST IT PUTLI9: RETURN ENTSEC IMPURE LSTREQ: .BLKW ;LIST REQUEST FLAGS LSTDEV: .BLKB 2 ;ERROR(LH), LISTING(RH) ENTSEC TXTBYT PAGMNE: .ASCII / PAGE / CRLF: .ASCIZ // XITSEC .IF NDF XBAW PROSW: ;PROCESS SWITCH ;IN - ASCII IN R0 ;OUT- .NE. 0 IF OK ENTOVR 1 SAVREG SETXPR ;SET EXPRESSION-TYPE REGISTERS MOV R0,(R1)+ ;SET "SYMBOL" CALL XCTLIN ;ZERO LINE-ORIENTED FLAGS SCANW SWTROL ;SCAN FOR SWITCH BEQ 1$ ; NOT FOUND, EXIT ZERO CLR (R3) ;CLEAR "MODE" MOV (R1),(R4) ;ADDRESS TO "VALUE" MOV #LINBUF,CHRPNT ;POINT TO START OF LINE SETNB ;SET R5 INC EXMFLG ;FLAG EXEC MODE CALL PROPC ;PROCESS AS OP-CODE CLR R0 ;ASSUME ERROR BIS ERRBTS,R5 ;ERROR OR NOT TERMINATOR? BNE 1$ ; YES, ERROR COM R0 ;OK, SET .NE. ZERO 1$: RETURN .ENDC XITOVR ENTSEC IMPLIN EXMFLG: .BLKW ;EXEC MODE FLAG XITSEC DNC: ;DECIMAL NUMBER CONVERSION MOV #10.,R3 ;SET DIVISOR DNCF: ;ENTRY FOR OTHER THAN DECIMAL CLR R0 DIV R3,R0 ;DIVIDE R1 MOV R1,-(SP) ;SAVE REMAINDER MOV R0,R1 ;SET FOR NEXT DIVIDE BEQ 1$ ; UNLESS ZERO CALL DNCF ;RECURSE 1$: MOV (SP)+,R1 ;RETRIEVE NUMBER ADD #DIG.0,R1 ;CONVERT TO ASCII MOVB R1,(R2)+ ;STORE RETURN R50UNP: ;RAD 50 UNPACK ROUTINE MOV R4,-(SP) ;SAVE REG MOV #SYMBOL,R4 ;POINT TO SYMBOL STORAGE 1$: MOV (R4)+,R1 ;GET NEXT WORD MOV #50*50,R3 ;SET DIVISOR CALL 10$ ;DIVIDE AND STUFF IT MOV #50,R3 CALL 10$ ;AGAIN FOR NEXT MOV R1,R0 CALL 11$ ;FINISH LAST GUY CMP R4,#SYMBOL+4 ;THROUGH? BNE 1$ ; NO MOV (SP)+,R4 ;YES, RESTORE REGISTER RETURN 10$: CLR R0 DIV R3,R0 11$: TST R0 ;SPACE? BEQ 23$ ; YES CMP R0,#33 ;TEST MIDDLE BLT 22$ ;ALPHA BEQ 21$ ;DOLLAR ADD #22-11,R0 ;DOT OR DOLLAR 21$: ADD #11-100,R0 22$: ADD #100-40,R0 23$: ADD #40,R0 MOVB R0,(R2)+ ;STUFF IT RETURN .SBTTL EXPRESSION EVALUATOR EXPR: ;EXPRESSION EVALUATION SAVREG ;SAVE REGISTERS TERM ;TRY FOR A TERM BEQ 5$ ;EXIT IF NULL CLR -(SP) ;NON-NULL, SET REGISTER FLAG STORAGE 1$: SETXPR ;SET EXPRESSION REGISTERS BIS (R3),(SP) ;SAVE REGISTER FLAG CHSCAN BOPTBL ;SCAN THE BINARY OPERATOR TABLE BEQ 2$ ; BRANCH IF NOT FOUND CALL 10$ ;FOUND, CALL HANDLER BR 1$ ;TEST FOR MORE 2$: BIC #-1-REGFLG,(SP) ;MASK ALL BUT REGISTER FLAG BEQ 6$ ;BRANCH IF NOT REGISTER BIT #177770,(R4) ;IN BOUNDS? BNE 7$ ; NO, ERROR 6$: ASR RELLVL ;TEST RELOCATON LEVEL BNE 3$ ;BRANCH IF NOT 0 OR 1 BCC 4$ ;BRANCH IF 0 TST (SP) ;RELOCATABLE, TEST REGISTER FLAG BEQ 4$ ;BRANCH IF NOT SET 7$: ERROR R ;REL AND REG, ERROR CLR (SP) ;CLEAR REGISTER BIT BR 4$ 3$: ERROR A ;IMPROPER RELOCATION 4$: BIS (SP)+,(R3) ;MERGE REGISTER BIT SETNZ R0 ;SET TRUE 5$: RETURN 10$: ENTOVR 8 MOV R0,-(SP) ;STACK OPERATOR ADDRESS MOV R1,R3 ;LEAVE POINTER TO "SYMBOL" IN R3 MOV (R1)+,-(SP) ;STACK SYMBOL MOV (R1)+,-(SP) MOV (R1)+,-(SP) ; MODE, MOV (R1)+,-(SP) ; VALUE, MOV (R1)+,-(SP) ; AND REL LEVEL GLBTRM ;EVALUATE NEXT TERN MOV #EXPBAK+^D10,R1 ;SET TO UNSTACK PREVIOUS MOV (SP)+,-(R1) ;REL LEVEL MOV (SP)+,-(R1) ;VALUE MOV R1,R2 ;R2 POINTS TO PREVIOUS VALUE MOV (SP)+,-(R1) ;MODE MOV (SP)+,-(R1) MOV (SP)+,-(R1) ;R1 POINTS TO PREVIOUS SYMBOL ASR (SP) ;ABSOLUTE ONLY? BCS 12$ ; NO BIS -(R2),-(R4) ;YES, MERGE FLAGS ABSTST ;TEST FOR ABSOLUTE CMP (R2)+,(R4)+ ;RESTORE REGISTERS 12$: ASL (SP) ;EVEN OUT ADDRESS JMPOVR (SP)+ ;EXIT THROUGH HANDLER ENTSEC IMPURE EXPBAK: .BLKW 5 ;PREVIOUS TERM STORAGE XITSEC ENTSEC DPURE BOPTBL: ;BINARY OP TABLE GCHTBL CH.ADD, BOPADD+1 ; "+" GCHTBL CH.SUB, BOPSUB+1 ; "-" GCHTBL CH.MUL, BOPMUL ; "*" GCHTBL CH.DIV, BOPDIV ; "/" GCHTBL CH.AND, BOPAND ; "&" GCHTBL CH.IOR, BOPIOR ; "!" .WORD 0 XITSEC BOPSUB: RELTST ;MAKE SURE NO GLOBALS NEG (R4) ; -, NEGATE VALUE NEG RELLVL ; AND RELLVL BOPADD: ADD (R2)+,(R4)+ ; +, ADD VALUES ADD (R2),(R4) ; AND RELOCATION LEVELS CMP -(R2),-(R4) ;POINT BACK TO VALUES BIT #GLBFLG!RELFLG,-(R2) ;ABS * XXX? BEQ 3$ ; YES, ALL SET BIT #GLBFLG!RELFLG,-(R4) ;XXX * ABS? BEQ 4$ ; YES, OLD FLAGS BITB #GLBFLG,(R2)+ ;ERROR IF EITHER GLOBAL BNE 5$ BITB #GLBFLG,(R4)+ BNE 5$ CMPB (R4),(R2) ;REL +- REL, SAME SECTOR? BNE 5$ ; NO, ERROR BISB #RELFLG,-(R4) TST RELLVL BNE 3$ BIC #177400!RELFLG,(R4) 3$: RETURN 4$: MOV (R1)+,(R3)+ MOV (R1)+,(R3)+ BIS (R1)+,(R3)+ RETURN 5$: JMP ABSERR BOPAND: COM (R2) BIC (R2),(R4) RETURN BOPIOR: BIS (R2),(R4) RETURN BOPMUL: ; * MOV (R2),R0 ;FETCH FIRST ARG MOV R0,-(SP) ;SAVE A COPY BPL 1$ ;POSITIVE? NEG R0 ; NO, MAKE IT SO 1$: MOV (R4),R3 ;SET SECOND ARG BPL 2$ ;BRANCH IF POSITIVE NEG R3 ;NEGATIVE, MAKE IT + COM (SP) ;TOGGLE RESULT SIGN 2$: MUL R3,R0 ;MULTIPLY MOV R1,R0 ;SET FOR EXIT BR BOPDVX ;EXIT THROUGH DIVIDE BOPDIV: ; / MOV (R4),R3 ;SET DIVISOR MOV R3,-(SP) ;SAVE A COPY BPL 1$ ;BRANCH IF PLUS NEG R3 ;MAKE IT THUS 1$: MOV (R2),R1 ;SET QUOTIENT BPL 2$ ;AGAIN!!! NEG R1 COM (SP) 2$: CLR R0 ;OPERATE DIV R3,R0 BOPDVX: TST (SP)+ ;TEST RESULT BPL 1$ ; OK AS IS NEG R0 ;NO, NEGATE IT 1$: MOV R0,(R4) ;SET RESULT RETURN XITOVR .IF NDF PDPV45 ;DIV R3,R0 (R0 IGNORED) ;MUL R3,R0 DIV: ;GENERAL DIVIDE ROUTINE MOV #16.,-(SP) ;LOOP COUNT CLR -(SP) ;RESULT 1$: ASL (SP) ;SHIFT RESULT ASL R1 ;SHIFT WORK REGISTERS ROL R0 ; DOUBLE REGISTER CMP R0,R3 ;BIG ENOUGH FOR OPERATION? BLT 2$ ; NO SUB R3,R0 ;YES INC (SP) ;BUMP RESULT 2$: DEC 2(SP) ;TEST FOR END BNE 1$ MOV R0,R1 ;PLACE REMAINDER IN R1 MOV (SP)+,R0 ;RESULT TO R0 DIVXIT: TST (SP)+ ;PRUNE STACK RETURN MUL: ;GENERAL MULTIPLY ROUTINE MOV R0,-(SP) ;GET THE FIRST GUY CLR R0 ;CLEAR RESULTS CLR R1 1$: TST (SP) ;THROUGH? BEQ DIVXIT ; YES ROR (SP) BCC 2$ ADD R3,R1 ADC R0 2$: ASL R3 BR 1$ .ENDC ;SPECIAL ENTRY POINT TO EXPR ;NULL FIELD CAUSES ERROR ;R0 SET TO VALUE GLBTRM: TERM BEQ ABSERR BR ABSERX GLBEXP: ;NON-NULL EXPRESSION EXPR BEQ ABSERR BR ABSERX RELTRM: GLBTRM BR RELTST RELEXP: GLBEXP RELTST: BIT #GLBFLG,FLAGS BEQ ABSERX BR ABSERR ABSTRM: GLBTRM BR ABSTST ABSEXP: GLBEXP ABSTST: BIT #GLBFLG!RELFLG,FLAGS BEQ ABSERX ABSERR: CLR MODE CLR RELLVL ABSERF: ERROR A ABSERX: MOV VALUE,R0 ;RETURN WITH VALUE IN R0 RETURN .SBTTL TERM EVALUATOR TERM: ;TERM EVALUATOR SAVREG ;SAVE REGISTERS SETXPR ; AND SET "EXPRESSION" TYPE CLR (R3) ;CLEAR MODE CLR (R4) ; AND VALUE CALL TERM10 ;PROCESS BIC #DEFFLG!LBLFLG!MDFFLG,(R3) ;CLEAR EXTRANEOUS CLR RELLVL ;ASSUME ABSOLUTE BIT #RELFLG,(R3) ;TRUE? BEQ 1$ INC RELLVL ; NO, RELOCATABLE 1$: INC EXPFLG ;MARK AS EXPRESSION JMP SETNB ;EXIT WITH NON-BLANK AND R0 SET TERM10: GETSYM ;TRY FOR A SYMBOL BEQ TERM20 ;BRANCH IF NOT A SYMBOL CMP SYMBOL,R50DOT ;LOCATION COUNTER? BEQ 14$ ; YES, TREAT SPECIAL SSRCH ;SEARCH THE SYMBOL TABLE .IF NDF XCREF MOV R0,-(SP) ;SAVE RESULT CRFREF ;CREF IT MOV (SP)+,R0 ;AND RESTORE RESULT .ENDC BEQ 16$ ;BRANCH IF NOT FOUND BIT #MDFFLG,(R3) ;MULTIPLY DEFINED? BEQ 11$ ; NO ERROR D ; YES 11$: BIT #DEFFLG,(R3) ;DEFINED? BNE 12$ ; YES BIT #GLBFLG,(R3) ;NO, GLOBAL? BNE TERM28 ; YES ERROR U ;NO, UNDEFINED ERROR 12$: BIC #GLBFLG,(R3) ;CLEAR INTERNAL GLOBAL FLAG BR TERM28 14$: .IF NDF XCREF MOV #SYMROL,ROLNDX ;CREF AS A SYMBOL CRFREF .ENDC MOV #CLCNAM,R1 ;DOT, MOVE TO WORKING AREA MOV #SYMBOL,R2 CALL XMIT4 CLRB (R3) ;CLEAR FLAGS TST (R3) ;ABSOLUTE SECTION? BEQ TERM28 ; YES BIS #RELFLG,(R3) ;NO, SET FLAG BR TERM28 16$: OSRCH ;NOT USER DEFINED, PERHAPS AN OP-CODE? TST (R3) ;OP CODE? BMI 17$ ;YES SSRCH ;SET SEARCH POINTERS .IF DF RSX11D BIS #DFGFLG!GLBFLG,(R3) BIT #ED.GBL,EDMASK BEQ 20$ BIC #DFGFLG!GLBFLG,(R3) .ENDC ERROR U 20$: INSERT ;NOT IN TABLE, INSERT AS UNDEFINED 17$: CLR (R3) ;BE SURE MODE IS ZERO BR TERM28 .IIF DF RSX11D, GENEDT GBL TERM20: MOV CRADIX,R2 ;ASSUME NUMBER, CURRENT RADIX 21$: CVTNUM ;CONVERT BEQ TERM30 ; NOPE, MISSED AGAIN BPL 22$ ;NUMBER, ANY OVERFLOW? ERROR T ; YES, FLAG IT 22$: CMP R5,#CH.DOT ;NUMBER, DECIMAL? BEQ 24$ ; YES .IF NDF XEDLSB CMP R5,#CH.DOL ;NO, LOCAL SYMBOL? BEQ 24$ ; YES .ENDC TSTB R0 ;NO, ANY NUMBERS OUT OF RANGE? BEQ TERM28 ; NO ERROR N ;YES, FLAG IT BR 23$ 24$: CMP R2,#10. ;"." OR "$", WERE WE DECIMAL? BEQ 25$ ; YES 23$: SETSYM ;NO, MOV #10.,R2 ; TRY AGAIN WITH DECIMAL RADIX BR 21$ 25$: CMP R5,#CH.DOT ;DECIMAL? BEQ TERM27 ; YES .IF NDF XEDLSB LSRCH ;NO, LOCAL SYMBOL BNE TERM27 ;BRANCH IF FOUND .ENDC TERM26: ERROR U ; NO, FLAG AS UNDEFINED TERM27: GETCHR ;BYPASS DOT OR DOLLAR TERM28: SETNB ;RETURN POINTING TO NON-BLANK SETNZ R0 ;FLAG AS FOUND TERM29: RETURN TERM30: CHSCAN UOPTBL ;SCAN UNARY OPERATOR TABLE BEQ TERM29 ; NOT THERE CLR R2 ;CLEAR FOR FUTURE USE CALL (R0) ;FOUND, GO AND PROCESS BR TERM28 ;EXIT TRUE ENTSEC DPURE UOPTBL: GCHTBL CH.ADD, GLBTRM ; "+" GCHTBL CH.SUB, TERM42 ; "-" GCHTBL CH.QTM, TERM44 ; """ GCHTBL CH.XCL, TERM45 ; "'" GCHTBL CH.PCT, TERM46 ; "%" GCHTBL CH.LAB, TERM47 ; "<" GCHTBL CH.UAR, TERM50 ; "^" .WORD 0 XITSEC TERM42: ABSTRM ;EVALUATE ABSOLUTE NEG (R4) ;NEGATE VALUE RETURN TERM44: INC R2 ; """, MARK IT TERM45: MOV R4,R1 ; "'", SET TEMP STORE REGISTER SETSYM ;POINT BACK TO OPERATOR 1$: GETCHR ;GET THE NEXT CHARACTER BEQ TERM48 ;ERROR IF EOL .IF NDF XEDLC MOVB @CHRPNT,(R1) ;STORE ABSOLUTE CHAR BICB #200,(R1)+ ;CLEAR POSSIBLE SIGN BIT AND INDEX .IFF MOVB R5,(R1)+ .ENDC DEC R2 ;ANOTHER CHARACTER BEQ 1$ ; YES BR TERM27 ;BYPASS LAST CHAR TERM46: ABSTRM ;REGISTER EXPRESSION BIS #REGFLG,(R3) ;FLAG IT RETURN TERM47: ; "<" GLBEXP ;PROCESS NON-NULL EXPRESSION CMP R5,#CH.RAB ;">"? BEQ TERM27 ; YES, BYPASS AND EXIT TERM48: JMP ABSERF ;ERROR, FLAG IT TERM50: ; "^" CHSCAN UARTBL ;SCAN ON NEXT CHARACTER BEQ TERM48 ; INVALID, ERROR JMP (R0) ;CALL ROUTINE ENTSEC DPURE UARTBL: ;UP ARROW TABLE GCHTBL LET.C, TERM51 ; ^C GCHTBL LET.D, TERM52 ; ^D GCHTBL LET.O, TERM53 ; ^O GCHTBL LET.B TERM54 ; ^B .IF NDF XFLTG GCHTBL LET.F, TERM55 ; ^F .ENDC .WORD 0 XITSEC TERM51: ABSTRM ;PROCESS ABSOLUTE COM (R4) ;COMPLEMENT VALUE RETURN TERM52: ADD #2.,R2 TERM53: ADD #6.,R2 TERM54: ADD #2.,R2 MOV CRADIX,-(SP) ;STACK CURRENT RADIX MOV R2,CRADIX ;REPLACE WITH LOCAL GLBTRM ;EVALUATE TERM MOV (SP)+,CRADIX ;RESTORE RADIX RETURN .IF NDF XFLTG TERM55: CALL FLTG1W ;PROCESS ONE WORD FLOATING BEQ TERM48 ;ERROR IF NULL RETURN .ENDC .SBTTL SYMBOL/CHARACTER HANDLERS GETSYM: SAVREG MOV CHRPNT,SYMBEG ;SAVE IN CASE OF RESCAN MOV #SYMBOL+4,R1 CLR -(R1) CLR -(R1) BITB CTTBL(R5),#CT.ALP ;ALPHA? BEQ 5$ ; NO, EXIT FALSE MOV #26455,R2 SETR50 1$: CALL MULR50 2$: ASR R2 BCS 1$ ADD R0,(R1) 3$: GETR50 BLE 4$ ASR R2 BCS 2$ BEQ 3$ TST (R1)+ BR 1$ 4$: SETNB 5$: MOV SYMBOL,R0 RETURN MULR50: ;MULTIPLY R0 * 50 IMULI 50,R0 RETURN GETR50: GETCHR SETR50: MOV R5,R0 TSTR50: BITB #CT.ALP!CT.NUM!CT.SP,CTTBL(R0) ;ALPHA, NUMERIC, OR SPACE? BEQ 1$ ; NO, EXIT MINUS CMP R0,#CH.DOL ;YES, TRY DOLLAR BLO 2$ ;SPACE BEQ 3$ ;DOLLAR CMP R0,#LET.A BLO 4$ ;DOT OR DIGIT BR 5$ ;ALPHA 1$: MOV #100000+SPACE,R0 ;INVALID, FORCE MINUS 2$: SUB #SPACE-11,R0 ;SPACE 3$: SUB #11-22,R0 ;DOLLAR 4$: SUB #22-100,R0 ;DOT, DIGIT 5$: SUB #100,R0 ;ALPHABETIC RETURN CVTNUM: ;CONVERT TEXT TO NUMERIC ; IN - R2 RADIX ; OUT - VALUE RESULT ; R0 - HIGH BIT - OVERFLOW ; - HIGH BYTE - CHARACTER COUNT ; - LOW BYTE - OVERSIZE COUNT SAVREG CLR R0 ;RESULT FLAG REGISTER CLR R1 ;NUMERIC ACCUMULATOR MOV CHRPNT,SYMBEG ;SAVE FOR RESCAN 1$: MOV R5,R3 ;GET A COPY OF THE CURRENT CHAR SUB #DIG.0,R3 ;CONVERT TO ABSOLUTE CMP R3,#9. ;NUMERIC? BHI 9$ ; NO, WE'RE THROUGH CMP R3,R2 ;YES, LESS THAN RADIX? BLO 2$ ; YES INC R0 ;NO, BUMP "N" ERROR COUNT 2$: .IF NDF PDPV45 MOV R2,R4 ;COPY OF CURRENT RADIX CLR -(SP) ;TEMP AC 3$: ASR R4 ;SHIFT RADIX BCC 4$ ;BRANCH IF NO ACCUMULATION ADD R1,(SP) ;ADD IN 4$: TST R4 ;ANY MORE BITS TO PROCESS? BEQ 5$ ; NO ASL R1 ;YES, SHIFT PATTERN BCC 3$ ;BRANCH IF NO OVERFLOW BIS #100000,R0 ;OH, OH. FLAG IT BR 3$ 5$: MOV (SP)+,R1 ;SET NEW NUMBER .IFF MUL R2,R1 .ENDC ADD R3,R1 ;ADD IN CURRENT NUMBER GETCHR ;GET ANOTHER CHARACTER ADD #000400,R0 ;TALLY CHARACTER COUNT BR 1$ 9$: MOV R1,VALUE ;RETURN RESULT IN "VALUE" RETURN ;RETURN, TESTING R0 GSARG: ;GET A SYMBOLIC ARGUMENT .ENABL LSB TSTARG ;TEST GENERAL BEQ 2$ ; EXIT NULL GSARGF: GETSYM ;ARG, TRY FOR SYMBOL BEQ 1$ ; ERROR IF NOT SYMBOL CMP R0,R50DOT ; "."? BNE 2$ ; NO, OK 1$: ERROR A CLR R0 ;TREAT ALL ERRORS AS NULL 2$: RETURN .DSABL LSB TSTARG: ;TEST ARGUMENT 1$: MOVB CTTBL(R5),R0 ;GET CHARACTERISTICS BLE 12$ ;THROUGH IF EOL OR SEMI-COLON TST ARGCNT ;FIRST ARGUMENT? BEQ 11$ ; YES, GOOD AS IS BIT #CT.COM,R0 ;NO, COMMA? BNE 10$ ; YES, BYPASS IT TST EXPFLG ;NO, WAS ONE REQUIRED? BEQ 2$ ; NO ERROR A ;YES, FLAG ERROR 2$: CMP CHRPNT,ARGPNT ;DID ANYBODY USE ANYTHING? BNE 11$ ; YES, OK 3$: GETCHR ;NO, BYPASS TO AVOID LOOPS BITB #CT.PC+CT.SP+CT.TAB-CT.COM-CT.SMC,CTTBL(R5) BNE 3$ ; YES, BYPASS SETNB ;NO, SET TO NON-BLANK ERROR A ;FLAG ERROR BR 1$ ;NOW TRY AGAIN 10$: GETNB ;BYPASS COMMA 11$: INC ARGCNT ;INCREMENT ARGUMENT COUNT 12$: CLR EXPFLG MOV CHRPNT,ARGPNT ;SAVE POINTER BIC #177600,R0 ;SET FLAGS RETURN ENTSEC IMPLIN ;CLEAR EACH LINE ARGCNT: .BLKW ;ARGUMENT COUNT ARGPNT: .BLKW ;START OF LAST ARGUMENT EXPFLG: .BLKW ;SET WHEN COMMA REQUIRED XITSEC CT.EOL= 000 ; EOL CT.COM= 001 ; COMMA CT.TAB= 002 ; TAB CT.SP= 004 ; SPACE CT.PCX= 010 ; PRINTING CHARACTER CT.NUM= 020 ; NUMERIC CT.ALP= 040 ; ALPHA, DOT, DOLLAR CT.LC= 100 ; LOWER CASE ALPHA CT.SMC= 200 ; SEMI-COLON (MINUS BIT) CT.PC= CT.COM!CT.SMC!CT.PCX!CT.NUM!CT.ALP ;PRINTING CHARS .MACRO GENCTT ARG ;GENERATE CHARACTER TYPE TABLE .IRP A, <ARG> .BYTE CT.'A .ENDM .ENDM ENTSEC DPURE CTTBL: ;CHARACTER TYPE TABLE GENCTT <EOL, EOL, EOL, EOL, EOL, EOL, EOL, EOL> GENCTT <EOL, TAB, EOL, EOL, EOL, EOL, EOL, EOL> GENCTT <EOL, EOL, EOL, EOL, EOL, EOL, EOL, EOL> GENCTT <EOL, EOL, EOL, EOL, EOL, EOL, EOL, EOL> GENCTT <SP , PCX, PCX, PCX, ALP, PCX, PCX, PCX> GENCTT <PCX, PCX, PCX, PCX, COM, PCX, ALP, PCX> GENCTT <NUM, NUM, NUM, NUM, NUM, NUM, NUM, NUM> GENCTT <NUM, NUM, PCX, SMC, PCX, PCX, PCX, PCX> GENCTT <PCX, ALP, ALP, ALP, ALP, ALP, ALP, ALP> GENCTT <ALP, ALP, ALP, ALP, ALP, ALP, ALP, ALP> GENCTT <ALP, ALP, ALP, ALP, ALP, ALP, ALP, ALP> GENCTT <ALP, ALP, ALP, PCX, PCX, PCX, PCX, PCX> GENCTT <EOL, LC , LC , LC , LC , LC , LC , LC > GENCTT <LC , LC , LC , LC , LC , LC , LC , LC > GENCTT <LC , LC , LC , LC , LC , LC , LC , LC > GENCTT <LC , LC , LC , EOL, EOL, EOL, EOL, EOL> XITSEC SETSYM: ;SET SYMBOL FOR RE-SCAN MOV SYMBEG,CHRPNT ;SET THE POINTER BR SETCHR ;SET CHARACTER AND FLAGS GETNB: ;GET A NON-BLANK CHARACTER INC CHRPNT ;BUMP POINTER SETNB: SETCHR ;SET REGISTER AND FLAGS BITB #CT.SP!CT.TAB,CTTBL(R5) ;BLANK? BNE GETNB ; YES, BYPASS BR SETCHR ;EXIT, SETTING FLAGS GETCHR: ;GET THE NEXT CHARACTER INC CHRPNT ;BUMP POINTER SETCHR: MOVB @CHRPNT,R5 ;SET REGISTER AND FLAGS .IF NDF XEDLC GENEDT LC,,1 ;LOWER CASE, DEFAULT TO OFF BPL 1$ ;OK IF NO SIGN BIT SUB #177600+40,R5 ;TRY FOR LOWER CASE MAP .ENDC BMI GETCHR ;LOOP IF INVALID CHARACTER 1$: RETURN CHSCAN: ;CHARACTER SCAN ROUTINE 1$: TST (R0)+ ;END (ZERO)? BEQ 2$ ; YES CMP (R0)+,R5 ;THIS THE ONE? BNE 1$ ; NO TST -(R0) ;YES, MOVE POINTER BACK MOV CHRPNT,SYMBEG ;SAVE CURRENT POINTER GETNB ;GET NEXT NON-BLANK 2$: MOV -(R0),R0 ;MOVE ADDR OR ZERO INTO R0 RETURN .SBTTL ROLL HANDLERS SSRCH: ;USER DEFINED OPERAND SEARCH SEARCH SYMROL RETURN OSRCH: ;OP-CODE SEARCH SEARCH PSTROL RETURN .IF NDF XMACRO MSRCH: SEARCH MACROL RETURN .ENDC .IF NDF XEDLSB LSRCH: ;LOCAL SYMBOL SEARCH TST LSYFLG ;FLAG SET? BEQ 1$ ; NO CLR LSYFLG ;YES, CLEAR IT INC LSYBKN ;BUMP BLOCK NUMBER 1$: MOV #SYMBOL,R0 MOV LSYBKN,(R0)+ ;MOVE INTO "SYMBOL" MOV VALUE,(R0) .IF NDF RSX11D BEQ 2$ ;ERROR IF ZERO CMP (R0),#^D127 ; OR > 127 BLOS 3$ .IFF BNE 3$ .ENDC 2$: ERROR T ;YES, FLAG ERROR 3$: SEARCH LSYROL ;SEARCH THE ROLL RETURN ENTSEC IMPPAS LSYFLG: .BLKW ;BUMPED AT "LABEL:" LSYBKN: .BLKW ;BLOCK NUMBER LSYBAS: .BLKW ;SECTION BASE LSGBAS: .BLKW ;BASE FOR GENERATED SYMBOLS XITSEC GENEDT LSB,LSBTST,1 ;LOCAL SYMBOL BLOCK .ENABL LSB LSBTST: BNE 2$ ;BYPASS IF /DS BR 1$ LSBSET: BIT #ED.LSB,EDMASK ;IN LSB OVER-RIDE? BEQ 2$ ; YES 1$: INC LSYFLG ;FLAG NEW BLOCK MOV CLCLOC,LSYBAS ;SET NEW BASE BIC #1,LSYBAS ;BE SURE ITS EVEN CLR LSGBAS ;CLEAR GENERATED SYMBOL BASE 2$: RETURN .DSABL LSB .ENDC .IF NDF RSX11D SEARCH: ;BINARY ROLL SEARCH SETROL ;SET ROLL REGISTERS MOV R3,-(SP) SUB R3,R1 ;POINT ONE SLOT LOW MOV R2,R3 SUB R1,R3 ;COMPUTE SIZE CLR R0 ;GET SET TO COMPUTE SEARCH OFFSET SEC ; (R0 DOUBLES AS T/F FLAG) 1$: ROL R0 ;SHIFT BIT BIC R0,R3 ;CLEAR CORRESPONDING BIT. LAST ONE? BNE 1$ ; NO 2$: ADD R0,R1 3$: ASR R0 ;END OF ITERATION, HALVE OFFSET BIC #2,R0 ;END? BEQ 7$ ; YES 4$: CMP R2,R1 ;OFF IN NO-MANS'S LAND? BLOS 6$ ; YES CMP (R4),(R1) ;NO, FIRST WORDS MATCH? BNE 5$ ; NO CMP 2(R4),2(R1) ;YES, HOW ABOUT SECOND? BEQ 8$ ; YES, FOUND 5$: BHI 2$ ;NO, BRANCH IF TOO HIGH 6$: SUB R0,R1 ;LOWER INDEX BR 3$ 7$: CMP (R1)+,(R1)+ ;POINT TO INSERTION SLOT 8$: MOV (SP)+,R3 BR SCANX ;EXIT THROUGH SCAN .IFF SEARCH: SETROL BIT #ED.REG,EDMASK ;REGISTER DEFINITION ENABLED? BNE 10$ ;IF NE NO CMP R5,#SYMROL ;SYMBOL ROLL? BNE 10$ ;IF NE NO BIT #7,(R4) ;MAKE RUFF RUFF TEST BYPASS 90% BNE 10$ ;IF NE DON'T CHECK FOR REGISTER SCAN REGROL ;SCAN REGISTER ROLL MOV R5,ROLNDX ;RESTORE ROLL INDEX TST R0 ;FIND SYMBOL? BEQ 10$ ;IF EQ NO FIND EM RETURN ; 10$: MOV R1,-(SP) ;SAVE ROLL BASE CMP R1,R2 ;ANY IN ROLL? BEQ 5$ ;IF EQ NO SUB R3,R2 ;CALCULATE HIGH AND LOW BOUNDS MOV R1,R0 ; BIC #177770,(SP) ; 1$: MOV R0,R1 ;CALCULATE TRIAL INDEX ADD R2,R1 ; ROR R1 ;HALVE RESULT BIC #7,R1 ;CLEAR GARBAGE BITS BIS (SP),R1 ; CMP (R1),(R4) ;COMPARE HIGH PARTS BHI 3$ ;IF HI SET NEW HIGH LIMIT BLO 2$ ;IF LO SET NEW LOW LIMIT CMP 2(R1),2(R4) ;COMPARE LOW PARTS BEQ 6$ ;IF EQ HIT BHI 3$ ;IF HI SET NEW HIGH LIMIT 2$: MOV R1,R0 ;SET NEW LOW LIMIT ADD R3,R0 ;REDUCE BY ONE MORE CMP R0,R2 ;ANY MORE TO SEARCH? BLOS 1$ ;IF LOS YES ADD R3,R1 ;POINT TO PROPER ENTRY BR 5$ ;EXIT 3$: MOV R1,R2 ;SE NEW HIGH LIMIT SUB R3,R2 ;REDUCE BY ONE MORE CMP R0,R2 ;ANY MORE TO SEARCH? BLOS 1$ ;IF LOS YES 5$: CLR R0 ;SET FALSE FLAG 6$: TST (SP)+ ;CLEAN STACK BR SCANX ;VAMMOOSA GENEDT REG .ENDC NEXT: ;GET THE NEXT ENTRY SETROL MOV ROLUPD,R0 ADD R0,R1 ADD R3,R0 CMP R1,R2 BLO SCANX BR SCANXF SCANW: ;SCAN ONE WORD SETROL ;SET REGISTERS CLR R0 ;ASSUME FALSE 1$: INC R0 ;TALLY ENTRY COUNT CMP (R4),(R1) ;MATCH? BEQ SCANY ; YES ADD R3,R1 ;NO, INCREMENT POINTER CMP R1,R2 ;FINISHED? BLO 1$ ; NO CLR R0 RETURN ;YES, EXIT FALSE SCAN: ;LINEAR ROLL SCAN SETROL ;SET ROLL REGISTERS CLR R0 ;ASSUME FALSE 1$: CMP R2,R1 ;END? BEQ SCANXF ; YES, EXIT FALSE INC R0 CMP (R4),(R1) ;NO, MATCH ON FIRST WORDS? BNE 2$ ; YES CMP 2(R4),2(R1) ;NO, HOW ABOUT SECOND? BEQ SCANX ; YES 2$: ADD R3,R1 ;INCREMENT BY SIZE BR 1$ .ENABL LSB SCANXF: CLR R0 ;FALSE EXIT SCANX: MOV R1,ROLPNT ;SET ENTRY POINTER MOV R0,ROLUPD ;SAVE FLAG BEQ 1$ ;BRANCH IF NOT FOUND SCANY: MOV R4,R2 ;POINTER TO "SYMBOL" NEG R3 ;NEGATE ENTRY SIZE JMP XMIT0(R3) ;FOUND, XFER ARGUMENTS 1$: CMP (R4)+,(R4)+ ;BYPASS SYMBOL ITSELF ASR R3 ;GET WORD COUNT SUB #2,R3 ;COMPENSATE FOR ABOVE CMP BLE 3$ ;BRANCH IF END 2$: CLR (R4)+ ;CLEAR WORD SOB R3,2$ 3$: RETURN .DSABL LSB APPEND: ;APPEND TO END OF ROLL SETROL MOV R2,ROLPNT ;SET POINTER CLR ROLUPD BR INSERF INSERT: ;INSERT IN ROLL CALL SETROF ;SET ROLL REGISTERS (BUT NO ARG) INSERF: MOV ROLPNT,R0 ;POINTS TO PROPER SLOT TST ROLUPD ;WAS SEARCH TRUE? BNE 5$ ; YES INCB ROLSIZ+1(R5) ;UPDATE ENTRY COUNT ADD R3,ROLTOP(R5) ;UPDATE TOP POINTER CMP R2,ROLBAS+2(R5) ;GAP BETWEEN ROLLS? BNE 5$ ; YES, JUST STUFF IT .IF NDF FIXSTK MOV SP,R1 ;"FROM" ADDRESS SUB R3,SP ;WE'RE ABOUT TO MOVE STACK MOV SP,R2 ;"TO" ADDRESS .IFF CALL TSTSYT ;TEST FOR ROOM MOV ROLBAS,R1 ;DITTO FOR SEPARATE STACK MOV R1,R2 SUB R3,R2 .IFTF SUB R1,R0 ;COMPUTE BYTE COUNT ASR R0 ; NOW WORD COUNT .IFF BEQ 4$ ;BRANCH IF FIRST TIME .ENDC 2$: MOV (R1)+,(R2)+ ;MOVE AN ENTRY DOWN SOB R0,2$ 4$: SUB R3,ROLBAS(R5) ;DECREMENT POINTERS SUB R3,ROLTOP(R5) SUB #2,R5 ;MORE ROLLS? BGE 4$ ; YES MOV R2,R0 ;POINT TO INSERTION SLOT 5$: ASR R3 ;HALVE SIZE COUNT 6$: MOV (R4)+,(R0)+ ;MOVE AN ENTRY INTO PLACE SOB R3,6$ ;LOOP IF NOT END RETURN ZAP: ;EMPTY A ROLL SETROL MOV R1,ROLTOP(R5) ;MAKE TOP = BOTTOM CLRB ROLSIZ+1(R5) ;CLEAR ENTRY COUNT RETURN SETROL: ;SET ROLL REGISTERS MOV R0,ROLNDX ;SET ARGUMENT SETROF: MOV (SP)+,R0 ;SAVE RETURN ADDRESS SAVREG ;SAVE REGISTERS MOV R5,-(SP) ; AND CURRENT CHARACTER MOV ROLNDX,R5 ;SET INDEX MOV ROLBAS(R5),R1 ;CURRENT BASE MOV ROLTOP(R5),R2 ;CURRENT TOP MOVB ROLSIZ(R5),R3 ;ENTRY SIZE MOV #SYMBOL,R4 ;POINTER TO SYMBOL CALL (R0) ;CALL PROPER ROUTINE MOV (SP)+,R5 ;RESTORE CURRENT CHARACTER RETURN ; AND REST OF REGS ENTSEC IMPURE ROLNDX: .BLKW ;ROLL INDEX ROLPNT: .BLKW ;ROLL POINTER ROLUPD: .BLKW ;ROLL UPDATE XITSEC .SBTTL UTILITIES SETXPR: ;SET EXPRESSION REGISTERS MOV #SYMBOL,R1 MOV #SECTOR,R2 MOV #MODE,R3 MOV #VALUE,R4 RETURN SAVREG: ;SAVE REGISTERS MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV 6.(SP),-(SP) ;PLACE RETURN ADDRESS ON TOP MOV R4,8.(SP) CALL TSTSTK ;TEST STACK CALL @(SP)+ ;RETURN THE CALL MOV (SP)+,R1 ;RESTORE REGISTERS MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 TST R0 ;SET CONDITION CODES RETURN .REPT MAXXMT-7 MOV (R1)+,(R2)+ ;PAD TO MAX NEEDED .ENDR XMIT7: MOV (R1)+,(R2)+ XMIT6: MOV (R1)+,(R2)+ XMIT5: MOV (R1)+,(R2)+ XMIT4: MOV (R1)+,(R2)+ XMIT3: MOV (R1)+,(R2)+ XMIT2: MOV (R1)+,(R2)+ XMIT1: MOV (R1)+,(R2)+ XMIT0: RETURN MOVBYT: ;MOVE BYTE STRING 1$: MOVB (R1)+,(R2)+ ;MOVE ONE BNE 1$ ;LOOP IF NON-NULL TSTB -(R2) ;END, POINT BACK TO NULL RETURN .IF DF TRAPS TRPPRO: ;TRAP PROCESSOR MOV (SP),2(SP) ;MOVE RETURN ADDRESS UP SUB #2,(SP) ;POINT TO TRAP INSTRUCTION MOV @(SP)+,-(SP) ;STACK IT ADD #TRPBAS-TRAP,(SP) ;FORM ADDRESS MOV @(SP)+,PC ;BRANCH AND PRUNE .ENDC .IF NDF XCREF CRFDEF: MOVB #'#,CRFBUF+11. ;CREF DEFINITION CRFREF: INC CRFCNT ;COUNT # OF REFERENCES TST CRFTST ;ANY CREF THIS TIME? BEQ 4$ ;NOPE - RETURN SAVREG CMPB #SYMROL,ROLNDX ;IS IT A SYMBOL? BNE 2$ ;NOPE - DONT CHECK FOR REG BIT #REGFLG,MODE ;ELSE IS IT REGISTER SYMBOL? BEQ 2$ ;NOPE MOV #REGROL,ROLNDX ;INDICATE REGISTER 2$: MOV #CRFBUF,R2 ;GET LINE BUFFER ADDRESS MOV #CRFTYP-1,R1 ;AND ADDR OF TYPE TABLE MOV CRFTST,R0 ;GET TYPES ENABLED STRING 1$: ASR R0 ;SHIFT TYPE MASK INC R1 ;SKIP PREVIOUS MATCH BYTE CMPB ROLNDX,(R1)+ ;FIND MATCHING TABLE BNE 1$ ;LOOP UNTIL FOUND ASR R0 ;MOVE MASK BIT TO CARRY BCC 4$ ;IS THIS TYPE DESIRED? MOVB @R1,(R2)+ ;MOVE INTO BUFFER R50UNP MOVB PAGNUM+1,(R2)+ ;MOVE IN PAGE NUMBER MOVB PAGNUM,(R2)+ MOVB LINNUM+1,(R2)+ ;AND LINE NUMBER MOVB LINNUM,(R2)+ BISB #SPACE,@R2 ;SET BLANK OR DEF FLAG TST CRFDFL ;CHECK FOR DESTRUCTIVE REF BPL 3$ ;NOPE - ALL SET MOVB #'*,@R2 ;ELSE FLAG IT 3$: MOV #12.,@CNTTBL+CRFCHN ;SET COUNT $WRITW CRF ;WRITE THE BUFFER 4$: CLRB CRFBUF+11. ;AND CLEAN UP FOR NEXT TIME RETURN ERRROL= 1 ;DUMMY ROLL FOR ERRORS REGROL= 3 ;DUMMY ROLL FOR REGISTERS ENTSEC IMPLIN CRFDFL: .BLKB 2 ;"#" AND "*" FLAGS ENTSEC TXTBYT CRFTYP: .BYTE SYMROL,<0*40>+<'S&37> .BYTE REGROL,<1*40>+<'R&37> .IF NDF XMACRO .BYTE MACROL,<2*40>+<'M&37> .IFF .BYTE -1,0 .ENDC .BYTE PSTROL,<3*40>+<'P&37> .BYTE SECROL,<4*40>+<'C&37> .BYTE ERRROL,<5*40>+<'E&37> XITSEC .ENDC .SBTTL MACRO HANDLERS .IF NDF XMACRO MT.RPT= 177601 MT.IRP= 177602 MT.MAC= 177603 MT.MAX= MT.MAC .GLOBL REPT, ENDR, ENDM REPT: ;REPEAT HANDLER ABSEXP ;EVALUATE COUNT MOV R0,-(SP) ;SAVE COUNT SETPF1 ;MARK THE LISTING CALL GETBLK ;GET A STORAGE BLOCK CLR (R2)+ ;START IN THIRD WORD CLR -(SP) ;NO ARGUMENTS MOV R0,-(SP) ; AND START OF BLOCK CALL ENDLIN ;POLISH OFF LINE ZAP DMAROL ;NO DUMMY ARGS FOR REPEAT CALL PROMT ;USE MACRO STUFF MOV #MT.RPT,R5 ;FUDGE AN "END OF REPEAT" REPTF: CALL WCIMT CALL MPUSH ;PUSH PREVIOUS MACRO BLOCK MOV (SP)+,(R2)+ ;STORE TEXT POINTER MOV (SP)+,(R2)+ ;STORE ARG POINTER CLR (R2)+ ;COUNTER MOV (SP)+,(R2)+ ;MAX SETCHR ;RESTORE CHARACTER ENDMAC: MOV #MSBCNT,R0 ;SET POINTER TO COUNT INC (R0) ;BUMP IT CMP (R0)+,(R0)+ ;THROUGH? BGT 1$ ; YES MOV MSBTXT,(R0) ;NO, SET READ POINTER ADD #4,(R0) ;BYPASS LINK RETURN 1$: CLR CNDMEX ;CLEAR MEXIT FLAG JMP MPOP ENDM: ENDR: ENTOVR 6 .IFTF .GLOBL OPCERR OPCERR: ERROR O RETURN .IFT XITOVR .GLOBL MACRO, MACR SETOVR 6 MACRO: MACR: ;MACRO DEFINITION GSARG ;GET THE NAME BEQ OPCERR ; ERROR IF NULL MACROF: TSTARG ;BYPASS POSSIBLE COMMA MOV SYMBOL,MACNAM MOV SYMBOL+2,MACNAM+2 MSRCH ;SEARCH THE TABLE MOV (R4),R0 ;GET THE POINTER BEQ 1$ ;BRANCH IF NULL CALL DECMAC ;DECREMENT THE REFERENCE 1$: CALL GETBLK ;GET A STORAGE BLOCK MOV R0,-(SP) ;SAVE POINTER MSRCH ;GETBLK MIGHT HAVE MOVED THINGS MOV (SP)+,(R4) ;SET POINTER INSERT ;INSERT IN TABLE CRFDEF CALL PROMA ;PROCESS DUMMY ARGS CLR (R2)+ ;CLEAR LEVEL COUNT MOV ARGCNT,(R2)+ ;KEEP NUMBER OF ARGS MOV MACGSB,(R2)+ ; AND GENERATED SYMBOL BITS BIS #LC.MD,LCFLAG CALL ENDLIN ;POLISH OFF LINE CALL PROMT ;PROCESS THE TEXT GETSYM BEQ 3$ CMP R0,MACNAM BNE 2$ CMP SYMBOL+2,MACNAM+2 BEQ 3$ 2$: ERROR A 3$: MOV #MT.MAC,R5 CALL WCIMT ;SET END MARKER SETCHR RETURN XITOVR MACROC: ;MACRO CALL ENTOVR 6 SETPF0 ;MARK LOCATION MOV VALUE,R0 ;GET BLOCK POINTER BEQ OPCERR ; ERROR IF NULL MOV R0,-(SP) CALL INCMAC ;INCREMENT REFERENCE CMP (R0)+,(R0)+ ;MOVE UP A COUPLE OF SLOTS MOV (R0)+,ARGMAX ;SET NUMBER OF ARGS MOV (R0)+,MACGSB ; AND GENERATED SYMBOL BITS MOV R0,-(SP) ;SAVE POINTER CALL PROMC ;PROCESS CALL ARGUMENTS MOV R0,R3 ;SAVE BLOCK POINTER MOV #MT.MAC,R5 CALL MPUSH ;PUSH NESTING LEVEL MOV (SP)+,MSBMRP MOV (SP)+,(R2)+ ;SET TEXT POINTER MOV R3,(R2)+ ; AND ARGUMENT POINTER MOV ARGCNT,(R2) ;FILL IN ARGUMENT COUNT MOV (R2)+,(R2)+ ; AND REPLECATE SETCHR RETURN XITOVR .GLOBL IRP, IRPC SETOVR 6 IRPC: INC R3 IRP: CALL GMARG BEQ 1$ CALL PROMA CALL RMARG CALL GMARG BEQ 1$ MOV #177777,ARGMAX ;ANY NUMBER OF ARGUMENTS CALL PROMCF MOV R0,R3 CALL RMARG CALL GETBLK CLR (R2)+ MOV ARGCNT,-(SP) MOV R3,-(SP) MOV R0,-(SP) CALL ENDLIN CALL PROMT MOV #MT.IRP,R5 JMP REPTF 1$: ERROR A RETURN XITOVR SETOVR 6 PROMA: ;PROCESS MACRO ARGS ZAP DMAROL ;CLEAR DUMMY ARGUMENT ROLL CLR ARGCNT ;GET A FRESH START WITH ARGUMENTS CLR MACGSB ;CLEAR GENERATED BIT PATTERN MOV #100000,-(SP) ;STACK FIRST GENERATED SYMBOL BIT 1$: TSTARG ;ANY MORE ARGS? BEQ 3$ ; NO, QUIT AND GO HOME CMP #CH.QM,R5 ;YES, GENERATED TYPE? BNE 2$ ; NO BIS (SP),MACGSB ;YES, SET PROPER BIT GETNB ;BYPASS IT 2$: CALL GSARGF ;GET SYMBOLIC ARGUMENT APPEND DMAROL ;APPEND TO DMA ROLL CLC ROR (SP) ;SHIFT GENERATED SYM BIT BR 1$ 3$: TST (SP)+ ;PRUNE STACK RETURN XITOVR SETOVR 6 PROMC: CLR R3 PROMCF: CLR ARGCNT CALL GETBLK MOV R0,-(SP) TST R3 BNE 7$ 1$: CMP ARGMAX,ARGCNT BLOS 10$ TSTARG ;BYPASS ANY COMMA BNE 9$ ;OK IF NON-NULL TST MACGSB ;NULL, ANY GENERATED STUFF LEFT? BEQ 10$ ; NO, THROUGH 9$: CMP #CH.BSL,R5 ; "\"? BEQ 20$ ; YES CALL GMARGF ;GET ARGUMENT .IF NDF XEDLSB TST R5 ;ANY ARGUMENTS? BNE 2$ ; YES TST MACGSB ;NO, GENERATION REQUESTED? BMI 30$ ; YES .ENDC 2$: 3$: CALL WCIMT BEQ 4$ GETCHR BR 3$ 4$: CALL RMARG 5$: ASL MACGSB ;MOVE GENERATION BIT OVER ONE BR 1$ 6$: INC ARGCNT GETCHR 7$: CALL WCIMT BEQ 10$ CLR R5 CALL WCIMT BR 6$ 10$: COM R5 CALL WCIMT COM R5 BIT #LC.MC,LCMASK ;MACRO CALL SUPPRESSION? BEQ 12$ ; NO MOV LBLEND,R0 ;YES, HAVE WE A LABEL? BEQ 11$ ; NO, SUPPRESS ENTIRE LINE MOV R0,LCENDL ;YES, LIST ONLY LABEL BR 12$ 11$: BIS #LC.MC,LCFLAG 12$: MOV (SP)+,R0 RETURN 20$: GETNB ; "\", BYPASS ABSEXP ;EVALUATE EXPRESSION, ABS MOV R5,-(SP) ;STACK CHARACTER MOV R3,-(SP) MOV CRADIX,R3 ;BREAK OUT IN CURRENT RADIX MOV R0,R1 ;VALUE TO R1 CALL 40$ ;CONVERT TO ASCII CLR R5 CALL WCIMT MOV (SP)+,R3 ;RESTORE REGS MOV (SP)+,R5 BR 5$ .IF NDF XEDLSB 30$: INC LSGBAS ;GENERATED SYMBOL, BUMP COUNT MOV LSGBAS,R1 ;FETCH IT ADD #^D<64-1>,R1 ;START AT 64. MOV R5,-(SP) ;STACK CURRENT CHAR MOV R3,-(SP) ;AND R3 MOV #10.,R3 ;MAKE IT DECIMAL CALL 40$ ;CONVERT TO ASCII MOV #CH.DOL,R5 CALL WCIMT ;WRITE "$" CLR R5 CALL WCIMT MOV (SP)+,R3 ;RESTORE REGS MOV (SP)+,R5 BR 4$ ;RETURN .ENDC 40$: ;MACRO NUMBER CONVERTER CLR R0 DIV R3,R0 MOV R1,-(SP) ;STACK REMAINDER MOV R0,R1 ;SET NEW NUMBER BEQ 41$ ;DOWN TO ZERO? CALL 40$ ; NO, RECURSE 41$: MOV (SP)+,R5 ;GET NUMBER ADD #DIG.0,R5 ;CONVERT TO ASCII JMP WCIMT ;WRITE IN TREE AND EXIT XITOVR PROMT: ENTOVR 6 CLR R3 1$: CALL GETLIN BNE 2$ BIS #LC.MD,LCFLAG CALL SETCLI BIT #DFLMAC,R0 BEQ 63$ INC R3 CMP #ENDM,VALUE BNE 3$ DEC R3 DEC R3 BPL 3$ 2$: RETURN 63$: .IF NDF XSML TST SMLLVL ;IN SYSTEM MACRO? BEQ 3$ ; NO BIT #DFLSMC,R0 ;YES, NESTED? BEQ 3$ ; NO CALL SMLTST ;YES, TEST FOR MORE .ENDC 3$: MOV #LINBUF,CHRPNT SETCHR 4$: GETSYM BEQ 7$ SCAN DMAROL MOV R0,R4 BEQ 5$ MOV ROLUPD,R5 NEG R5 DEC CONCNT CALL WCIMT DEC CONCNT 5$: SETSYM 6$: TST R4 BNE 61$ CALL WCIMT 61$: GETR50 BGT 6$ 7$: CMP R5,#CH.XCL BEQ 8$ CALL WCIMT BNE 9$ CALL ENDLIN BR 1$ 8$: INC CONCNT 9$: GETCHR BR 4$ XITOVR .GLOBL NARG, NCHR, NTYPE, MEXIT SETOVR 2 NARG: ;NUMBER OF ARGUMENTS CALL GSARG ;GET A SYMBOL BEQ NTYPER ;ERROR IF MISSING MOV MSBCNT+2,R3 ;SET NUMBER BR NTYPEX NCHR: ;NUMBER OF CHARACTERS CALL GSARG BEQ NTYPER ; ERROR ID NO SYMBOL CALL GMARG ;ISOLATE ARGUMENT BEQ NTYPEX ; ZERO IF NULL TST R5 ;QUICK TEST FOR COMPLETION BEQ 2$ ; YES 1$: INC R3 ;BUMP COUNT GETCHR ;GET THE NEXT CHARACTER BNE 1$ ;LOOP IF NOT END 2$: CALL RMARG ;REMOVE ARG DELIMITERS BR NTYPEX NTYPE: ;TEST EXPRESSION MODE CALL GSARG ;GET THE SYMBOL BEQ NTYPER ; ERROR TSTARG ;BYPASS ANY COMMAS MOV #SYMBOL,R1 MOV (R1)+,-(SP) ;PRESERVE SYMBOL MOV (R1)+,-(SP) CALL AEXP ;EVALUATE MOV R0,R3 ;SET RESULT ZAP CODROL ;CLEAR ANY GENERATED CODE MOV (SP)+,-(R1) ;RESTORE SYMBOL MOV (SP)+,-(R1) NTYPEX: CLR MODE ;CLEAR MODE MOV R3,VALUE ; AND SET VALUE JMP ASGMTF ;EXIT THROUGH ASSIGNMENT NTYPER: ERROR A BR NTYPEX MEXIT: ;MACRO/REPEAT EXIT MOV MACLVL,CNDMEX ;IN MACRO? BNE 1$ ; YES, POP ERROR O ; NO, ERROR 1$: RETURN XITOVR GENCND B, TCB GENCND NB, TCB, F GENCND IDN, TCID GENCND DIF, TCID, F SETOVR 5 TCB: ; "IFB" CONDITIONAL BEQ TCBERX ;OK IF NULL CALL GMARGF ;ISOLATE ARGUMENT SETNB ;BYPASS ANY BLANKS BEQ TCIDT ;TRUE IF POINTING AT DELIMITER BR TCIDF ;ELSE FALSE TCBERR: ERROR A ;NAUGHTY TCBERX: RETURN TCID: ; "IFIDN" CONDITIONAL BEQ TCBERR ;ERROR IF NULL ARG CALL GMARGF ;ISOLATE FIRST ARG MOV CHRPNT,R1 ;SAVE CHARACTER POINTER TST -(R0) MOV -(R0),R2 ;POINTER TO TERMINATOR CALL RMARG ;RETURN THIS ARG CALL GMARG ;GET THE NEXT BEQ TCBERR 1$: MOVB (R1),R0 ;SET CHARACTER FROM FIRST FIELD CMP R1,R2 ;IS IT THE LAST? BNE 2$ ; NO CLR R0 ;YES, CLEAR IT 2$: CMP R0,R5 ;MATCH? BNE TCIDF ; NO TST R5 ;YES, FINISHED? BEQ TCIDT ; YES, GOOD SHOW GETCHR ;NO, GET THE NEXT CHARACTER INC R1 ;ADVANCE FIRST ARG POINTER BR 1$ ;TRY AGAIN TCIDF: COM R3 ;FALSE, TOGGLE CONDITION TCIDT: JMP RMARG ;OK, RESTORE ARGUMENT XITOVR GMARG: ;GET MACRO ARGUMENT TSTARG ;TEST FOR NULL BEQ GMARGX ; YES, JUST EXIT GMARGF: SAVREG ;STASH REGISTERS CLR R1 ;CLEAR COUNT MOV #CHRPNT,R2 MOV (R2),-(SP) ;SAVE INITIAL CHARACTER POINTER MOV #CH.LAB,R3 ;ASSUME "<>" MOV #CH.RAB,R4 CMP R5,R3 ;TRUE? BEQ 11$ ; YES CMP R5,#CH.UAR ;UP-ARROW? BEQ 10$ ; YES 1$: BITB #CT.PC-CT.COM-CT.SMC,CTTBL(R5) ;PRINTING CHARACTER? BEQ 21$ ; NO GETCHR ;YES, MOVE ON BR 1$ 10$: GETNB ; "^", BYPASS IT BEQ 20$ ;ERROR IF NULL MOV (R2),(SP) ;SET NEW POINTER COM R3 ;NO "<" EQUIVALENT MOV R5,R4 ;">" EQUIVALENT 11$: GETCHR BEQ 20$ ; ERROR IF EOL CMP R5,R3 ; "<"? BEQ 12$ ; YES CMP R5,R4 ;NO, ">"? BNE 11$ ; NO, TRY AGAIN DEC R1 ;YES, DECREMENT LEVEL COUNT DEC R1 12$: INC R1 BPL 11$ ;LOOP IF NOT THROUGH INC (SP) ;POINT PAST "<" BIS #100000,R5 ;MUST MOVE PAST IN RMARG BR 21$ 20$: ERROR A 21$: MOV GMAPNT,R0 ;GET CURRENT ARG SAVE POINTER BNE 22$ ;BRANCH IF INITIALIZED MOV #GMABLK,R0 ;DO SO 22$: MOV (R2),(R0)+ ;SAVE POINTER MOV R5,(R0)+ ; AND CHARACTER CLRB @(R2) ;SET NULL TERMINATOR MOV (SP)+,(R2) ;POINT TO START OF ARG SETCHR ;SET REGISTER 5 MOV R0,GMAPNT ;SAVE NEW BUFFER POINTER GMARGX: RETURN RMARG: ;REMOVE MACRO ARGUMENT MOV GMAPNT,R0 ;SET POINTER TO SAVED ITEMS MOV -(R0),R5 ;SET CHARACTER TST -(R0) MOVB R5,@(R0) ;RESTORE VIRGIN CHARACTER ASL R5 ADC (R0) MOV (R0),CHRPNT SETNB MOV R0,GMAPNT RETURN ENTSEC IMPPAS GMAPNT: .BLKW 1 ;POINTER TO FOLLOWING BUFFER GMABLK: .BLKW 1 ;POINTER TO "BORROWED" CHARACTER .BLKW 1 ;CHARACTER ITSELF .BLKW 3*2 ;ROOM FOR MORE PAIRS XITSEC WCIMT: ;WRITE CHARACTER IN MACRO TREE DEC CONCNT ;ANY CONCATENATION CHARS PENDING? BMI 1$ ; NO MOV R5,-(SP) ;YES, STACK CURRENT CHARACTER MOV #CH.XCL,R5 CALL 2$ MOV (SP)+,R5 BR WCIMT 1$: CLR CONCNT 2$: BIT #BPMB-1,R2 ;ROOM IN THIS BLOCK? BNE 3$ ; YES SUB #BPMB,R2 ;NO, POINT TO LINK MOV R2,-(SP) CALL GETBLK MOV R0,@(SP)+ ;SET NEW LINK 3$: MOVB R5,(R2)+ ;WRITE, LEAVING FLAGS SET RETURN GETBLK: ;GET A MACRO BLOCK MOV MACNXT,R0 ;TEST FOR BLOCK IN GARBAGE BNE 1$ ; YES, USE IT APPEND MABROL ;NO, GET BLOCK IN ROLL MOV ROLBAS+MABROL,R0 ;GET START MOV R0,ROLTOP+MABROL ;ZAP MAB ROLL MOV R0,ROLBAS+MAAROL ;AWARD SPACE TO MAA BR 2$ 1$: MOV (R0),MACNXT ;SET NEW CHAIN 2$: MOV R0,R2 CLR (R2)+ ;CLEAR LINK CELL, POINT PAST IT RETURN INCMAC: INC 2(R0) ;INCREMENT MACRO REFERENCE RETURN DECMAC: DEC 2(R0) ;DECREMENT MACRO STORAGE BPL REMMAX ;JUST EXIT IF NON-NEGATIVE REMMAC: MOV R0,-(SP) ;SAVE POINTER 1$: TST (R0) ;END OF CHAIN? BEQ 2$ ; YES MOV (R0),R0 ;NO, LINK BR 1$ 2$: MOV MACNXT,(R0) MOV (SP)+,MACNXT REMMAX: RETURN MPUSH: ;PUSH MACRO NESTING LEVEL CALL GETBLK ;GET A STORAGE BLOCK TST -(R2) ;POINT TO START MOV #MSBBLK,R1 ;POINTER TO START OF PROTOTYPE MOV R2,-(SP) ;SAVE DESTINATION MOV R1,-(SP) ; AND CORE POINTERS 1$: MOV (R1),(R2)+ ;XFER AN ITEM CLR (R1)+ ;CLEAR CORE SLOT CMP #MSBEND,R1 ;THROUGH? BNE 1$ ; NO MOV (SP)+,R2 ;YES, MAKE CORE DESTINATION MOV R5,(R2)+ ;SAVE TYPE MOV (SP)+,(R2)+ ; AND PREVIOUS BLOCK POINTER INC MACLVL ;BUMP LEVEL COUNT RETURN ;RETURN WITH R2 POINTING AT MSBTXT MPOP: ;POP MACRO NESTING LEVEL MOV #MSBARG+2,R2 ;POINT ONE SLOT PAST ARG MOV -(R2),R0 ;GET POINTER TO ARG BLOCK BEQ 1$ ;BRANCH IF NULL CALL REMMAC ;REMOVE IT 1$: MOV -(R2),R0 ;POINT TO TEXT BLOCK BEQ 2$ ;BRANCH IF NULL CALL DECMAC ;DECREMENT LEVEL 2$: MOV -(R2),R1 ;GET PREVIOUS BLOCK TST -(R2) ;POINT TO START MOV R1,R0 ;SAVE BLOCK POINTER CALL XMIT0-<MSBEND-MSBBLK> ;XFER BLOCK CLR (R0) ;CLEAR LINK CALL REMMAC ;RETURN BLOCK FOR DEPOSIT DEC MACLVL ;DECREMENT LEVEL COUNT RETURN ENTSEC IMPURE MSBBLK: ;PUSHABLE BLOCK (MUST BE ORDERED) MSBTYP: .BLKW ;BLOCK TYPE MSBPBP: .BLKW ;PREVIOUS BLOCK POINTER MSBTXT: .BLKW ;POINTER TO BASIC TEXT BLOCK MSBARG: .BLKW ;POINTER TO ARG BLOCK MSBCNT: .BLKW 2 ;REPEAT COUNT, ETC. MSBMRP: .BLKW ;MACRO READ POINTER MSBEND: ;END OF ORDERED STORAGE MACNXT: .BLKW MACLVL: .BLKW ;MACRO LEVEL COUNT CONCNT: .BLKW ARGMAX: .BLKW MACNAM: .BLKW 2 MACGSB: .BLKW ;MACRO GENERATED SYMBOL BITS XITSEC .IF NDF XSML .GLOBL MCALL ;.MCALL SETOVR 6 MCALL: CALL SMLTST ;TEST FOR UNDEFINED ARGUMENTS BEQ 5$ ; BRANCH IF NONE TST PASS ;FOUND SOME, PASS ONE? BNE 4$ ; NO, ERROR 1$: CALL INISML ;GET ANOTHER FILE BEQ 4$ ; ERROR IF NONE 2$: CLR R3 ;SET COUNT TO ZERO 3$: CALL GETLIN ;GET A NEW LINE BNE 1$ ;TRY ANOTHER FILE IF EOF CALL SETCLI ;TEST FOR DIRECTIVE BIT #DFLMAC,R0 ;MACRO/ENDM? BEQ 3$ ; NO MOV #VALUE,R4 ;SET FOR LOCAL AND MACROF DEC R3 ;YES, ASSUME .ENDM CMP #ENDM,(R4) ;GOOD GUESS? BEQ 3$ ; YES INC R3 ;NO, BUMP COUNT INC R3 CMP #1,R3 ;OUTER LEVEL? BNE 3$ ; NO GSARG ;YES, GET NAME BEQ 4$ ; ERROR IF NULL MSRCH ;SEARCH TABLE BEQ 3$ ;IGNORE IF NOT THERE TST (R4) ;FOUND, VALUE OF ZERO? BNE 3$ ; NO, NOT INTERESTED CALL MACROF ;GOOD, DEFINE IT DEC SMLLVL ;DECREMENT COUNT BGT 2$ ;LOOP IF MORE TO GO BR 5$ ;OK, CLEAN UP 4$: ERROR U 5$: CLR SMLLVL ;MAKE SURE COUNT IS ZAPPED CLR ENDFLG ;DITTO FOR END FLAG JMP FINSML ;BE SURE FILES ARE CLOSED SMLTST: ;TEST MCALL ARGUMENTS 1$: GSARG ;FETCH NEXT ARGUMENT BEQ 3$ ; EXIT IF THROUGH MSRCH ;OK, TEST FOR MACROS BNE 2$ ; FOUND, NOT INTERESTED INSERT ;INSERT WITH ZERO POINTER INC SMLLVL ;BUMP COUNT 2$: CRFDEF ;CREF IT BR 1$ 3$: MOV SMLLVL,R0 ;FINISHED, COUNT TO R0 RETURN ENTSEC IMPPAS SMLLVL: .BLKW ;MCALL HIT COUNT XITSEC .ENDC ;XSML XITOVR .ENDC ;XMACRO .EOT �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������; MACRO5.MAC V02-11 .NLIST ; COPYRIGHT (C) 1974,1975 ; ; DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASSACHUSETTS 01754 ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH ; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, ; OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE ; AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ; ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DIGITAL. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO ; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED ; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DIGITAL. ; .LIST .SBTTL ////////FILE #5//////// .IF DF OVLAY .GLOBL OVRTBL, OVRXCT ENTSEC MACOVR ;OVERLAY SECTOR ;THE FOLLOWING DUMMY ENTRY POINTS MUST BE GROUPED! ;******* OVRNAM: .RAD50 /MACRO / ;OVERLAY NAME CALOVR: MOV @(SP)+,-(SP) ;IN-LINE OVERLAY ENTRIES CALOVF: RETURN ;OVERLAY ENTRIES TO (SP) BLDOVR: RETURN ;OVERLAY BUILDER RLSOVR: RETURN ;RELEASE OVERLAY ;******* ENTSEC MIXED OVRLEN= 0 OVRTBL: XXX= 0 .RADIX 10 .REPT NUMOVR XXX= XXX+1 .IRP N,<\XXX> ENTSEC OVR'N .IIF GT .-OVR'N'B-OVRLEN, OVRLEN=.-OVR'N'B ENTSEC MIXED .WORD OVR'N'B .ENDM .ENDR .RADIX 8 ENTSEC OVRSEP OVRXCT= .-OVRLEN ;START OF EXECUTION AREA .GLOBL OVRXCT ENTSEC MIXED .WORD OVRSEP XITSEC .ENDC .SBTTL FIN ENTSEC IMPURE ;CLOSE OUT IMPURE SECTORS IMPURT: ENTSEC IMPPAS IMPPAT: ENTSEC IMPLIN IMPLIT: ENTSEC XCTPRG JMP XCTPAS ENTSEC XCTPAS JMP XCTLIN ENTSEC XCTLIN RETURN ;RETURN FROM ANY OF THE ABOVE ENTSEC SWTSEC SWTTOP: ENTSEC EDTSEC EDTTOP: ENTSEC CNDSEC CNDTOP: ;TOP OF CONDITIONAL ROLL XITSEC ;BE NEAT .END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������