Directory of image this file is from
This file as a plain text file
/RASBOL-8 MICRO PROGRAM / /PAL III EXTENDED SYMBOLS TAPE 1 - JANUARY 1973 / /FOR USE WITH RASBOL-8 MICRO PROGRAM SYMBOLIC TAPE / /MQ MICROINSTRUCTIONS MLD=7421 MQA=7501 CAM=7621 SWP=7521 ALD=7701 /POWER FAIL DETECTION AND RESTART TYPE KP8-E SPL=6102 /MEMORY EXTENSION AND TIME SHARE TYPE KM8-E GTF=6004 RTF=6005 CDI=6203 /PDP8-E GROUP 1 OPERATE MICROINSTRUCTION BSW=7002 /1.6M BYTE CARTRIDGE DISK TYPE RK8-E DSKP=6741 DCLA=6742 DLAG=6743 DLCA=6744 DRST=6745 DLDC=6746 FIXTAB /PAL III EXTENDED SYMBOLS TAPE 2 - JANUARY 1973 / /FOR USE WHEN ASSEMBLING THE RASBOL-8 INTERPRETER PROGRAM / /RASBOL-8 INSTRUCTION SET NOP=0000 CLEAR=0001 NEGATE=0002 REMAIN=0003 EXIT=0004 LINCAC=0005 WRITE=0006 WRITSQ=0007 WRITAB=0010 RBSW=0011 PRINTO=0012 FILZRO=0013 FILSPC=0014 PRNTCH=0015 TYPIN=0100 TYPCH=0100 PRINT=0200 SIGN1=0310 SIGN2=0320 SHIFTR=0340 MULTX1=0400 MULTX2=0500 STORX1=0610 STORX2=0620 STORX3=0630 STORLC=0640 CLEARLC=0650 OPEN=0700 CLOSE=0701 READAB=0702 LOAD=1030 LOAD2=1020 LOAD1=1010 LOADIM=1000 ADD=1130 ADD2=1120 ADD1=1110 ADDIM=1100 SUBT=1230 SUBT2=1220 SUBT1=1210 SUBTIM=1200 ADDTO=1330 ADDTO2=1320 ADDTO1=1310 MULT=1430 MULT2=1420 MULT1=1410 MULTIM=1400 DIVID=1530 DIVID2=1520 DIVID1=1510 DIVIM=1500 STORE=1630 STORE2=1620 STORE1=1610 INCREM=1700 CLEARW=1710 DECREM=1720 ANDIM=2000 ORIM=2100 GETREC=2200 PUTREC=2300 GOTO=3000 GOZERO=3010 GOPOS=3020 GONEG=3030 GONZRO=3040 GOSUB=3100 GOPAL=3200 LOADX1=3310 LOADX2=3320 LOADX3=3330 LOADLC=3340 YESNO=3500 ABORT=3510 PRINTC=3600 READ=3700 READSQ=3710 TYPTEX=4000 TYPWDS=4100 PRINTU=4200 PRINTX=4300 PRINTW=4400 GOIF=4500 INCGOZ=4600 DECGOZ=4700 GOIFZO=5000 GOWDZO=GOIFZO MOVIM=5100 CLRWDS=5200 MOVE1=5300 MOVE2=5400 MOVE3=5500 GOIFEQ=5600 CONVBW=6000 CONVWB=6100 MOVE=6200 COMPAR=6300 CONV6W=6400 CONVW6=6500 GOWDEQ=6600 PICTUR=7000 FILL=7100 RANGE=7300 DOVAR=7600 DO=7700 XAREA=7200 TAB=0211 BELL=0207 FF=0214 VT=0213 SPACE=0240 FIXTAB /RASBOL-8 MICRO PROGRAM / /WRITTEN BY: NOEL K. GODDARD / AND: ROYCE A. SMITH / /DATE: JANUARY 1973 / /FOR: RASMITH INDUSTRIAL SYSTEMS / 30 BURRANEER AVENUE / ST IVES N.S.W. 2075 / /THIS PROGRAM IS DESIGNED TO OPERATE IN AN /INTERPRETIVE MODE TO EXECUTE THE SET OF "MACRO /INSTRUCTIONS" WHICH FORM A RASBOL-8 PROGRAM / /EACH MACRO INSTRUCTION CONSISTS OF ONE TO FOUR (OR /MORE) WORDS OF CORE STORAGE. THESE ARE SEQUENTIALLY /INTERPRETED AND EXECUTED BY THE MICRO PROGRAM / /DEFINE SYMBOLIC ORIGIN / R8ORG=200 / /DEFINE ASSEMBLY SWITCH / ODTRUN=0 DECWRIT=0 / /CLEAR ALL PAGE ZERO LOCATIONS NOT USED BY OS/8 / *0002 ZBLOCK 6 / 0002 - 0007 / *0011 ZBLOCK 165 / 0011 - 0175 / / /DEFINE PAGE ZERO LOCATIONS USED BY THE MICRO PROGRAM / /WORK LOCATIONS USED FOR TRANSLATING MICRO INSTRUCTION / INST=2 /12 BIT MACRO INSTRUCTION F1=3 /FIELD BITS FOR 1ST ARGUMENT IFZERO ODTRUN < F2=4 /FIELD BITS FOR 2ND ARGUMENT OPCODE=5 /MACRO INSTRUCTION 6 BIT OPCODE INSTRH=6 / " " OTHER 6 BITS> IFNZRO ODTRUN < F2=135 OPCODE=136 INSTRH=137> SFLAG=7 /MICRO PROGRAM OPERATION FLAG / /DEFINE FIVE AUTO INDEX REGISTERS / IR1=11 IR2=12 IR3=13 IR4=14 IR5=15 / /MACRO INSTRUCTION TRANSLATION WORK LOCATIONS (CONT.) / CRIA=20 /ADDRESS OF CURRENT MACRO INSTRUCTION CRIF=21 / FIELD " " " " CIWA=22 /ADDRESS " NEXT " " ARG1=23 /1ST ARGUMENT ARG2=24 /2ND " COUNT=25 /LENGTH ARG1F=26 /CDF INSTRUCTION FOR 1ST ARGUMENT ARG2F=27 / " " " 2ND " RCDFI=30 /BASIC CDF INSTRUCTION DRTSL1=31 /TEMPORARY WORK LOCATION 1 DRTSL2=32 / " " " 2 DRTSL3=33 / " " " 3 DRTSL4=34 / " " " 4 /
/DEFINE 36 BIT ACCUMULATOR COPY REGISTER / ACCH=35 ACCM=36 ACCL=37 / /DEFINE 36 BIT ACCUMULATOR
/ ACH=40 ACM=41 ACL=42 / /DEFINE 36 BIT MULTIPLIER QUOTIENT REGISTER / MQH=43
MQM=44 MQL=45 / /DEFINE TWO 36 BIT STORAGE REGISTERS / SRH=46 SRM=47 SRL=50 / SR1H=51 SR1M=52 SR1L=53 / /DEFINE THREE 12 BIT SCRATCH PAD LOCATIONS / ERS0=54 ERS1=55 ERS2=56 / /DEFINE TWO 12 BIT MACRO INDEX REGISTERS / X1=16 X2=60 / /TO ENSURE THAT THESE WORK LOCATIONS ARE ZERO /BEFORE THEY ARE USED, DEFINE A ZERO BLOCK / *35 DECIMAL ZBLOCK 20 OCTAL / /DEFINE THREE INPUT OUTPUT CHARACTER STORAGE VECTORS / *61 DECIMAL TS, ZBLOCK 11 / TS1, ZBLOCK 10 / TS2, ZBLOCK 21 OCTAL / /NOW DEFINE THE ENDS OF THE CHARACTER STORAGE VECTORS / TSE=73 / TS1P=104 TS1E=105 / TS2E=132 / / /DEFINE TWO WORK LOCATIONS USED BY THE DISK ROUTINES /AND ANOTHER TO BE USED AS A FORM LINE COUNT / CTDEV=133 /DEVICE NUMBER CTBLK=134 /BLOCK NUMBER IFZERO ODTRUN < LINKNT=135 /LINE COUNT> X3=136 / /DEFINE TWO MORE MICRO PROGRAM OPERATION FLAGS / IFZERO ODTRUN < SFLAG1=136 /MICRO PROGRAM OPERATION FLAG> IFNZRO ODTRUN < SFLAG1=16> / IFZERO ODTRUN < MFLAG=137 /MULTIPLY FLAG> IFNZRO ODTRUN < MFLAG=17> / /DEFINE SYMBOLIC TRANSFER VECTOR / *140 TVBTST,BTRSET TVMOER,MOBERR TVBLKO,BLOKOP TVRAXT,RAEXIT TVSTOR,STORER TVCLAM,CLAM TVSWAM,SWAM TVADDS,ADDS TVTMPY,TMPY TVCOMP,COMP TVTDIV,TDIV TVCBCH,CBCH TVCLR,CLR TVBTR,BTR TVSBUP,SBUP TVSBTA,SBTA TVPACK,PACK TVPRNT,PRNT TVCMPA,CMPA TVPDPR,PDPR TVOBTN,OBTN TVPRCH,PRNCH TVABC,ABC TVCBSV,CBSV TVFAIL,PFAIL TVMBNT,MBIENT TVMST,START / /DEFINE TRANSFER VECTOR / / /SET INITIAL FIELD TO 1 / *21 0010 / /SET BASIC CDF INSTRUCTION / *30 6201 / /TOTAL NUMBER OF LOCATIONS ON PAGE ZERO: 128 / / " " " " USED BY MICRO: 121 / / " " " " " " OS/8: 005 / / " " " FREE PAGE ZERO LOCATIONS: 002 / /THE FIVE LOCATIONS USED BY OS/8 ARE:- / 0000 - 0001 COMMUNICATION AND BREAKDOWN / 0010 AUTO INDEX REGISTER / /THE TWO FREE LOCATIONS ARE:- / 0016 - 0017 AUTO INDEX REGISTERS / /THE RASBOL-8 SOURCE PROGRAM MAY USE ANY OR ALL /OF THESE FREE LOCATIONS IN ANY DESIRED WAY / /IN THIS MULTI-DEVICE VERSION OF RASBOL-8 THE FOLLOWING /CONDITIONS ARE ESTABLISHED. THE PAGE STARTING AT ADDRESS / 06200 IS RESERVED FOR FILE INFORMATION AREAS, AND THE TWO /PAGES FROM 07200 UPWARDS ARE RESERVED FOR THE DATA BLOCK. /THE THREE PAGES IN BETWEEN, I.E. FROM 06400 TO 07177, ARE SET /ASIDE FOR ANY COMBINATION OF ONE AND TWO PAGE DEVICE HANDLERS / / FILBLK=7200 /TWO PAGES FOR DATA BLOCK /
/ /RASBOL-8 MICRO PROGRAM - TAPE 2 / /THE FIRST SECTION OF THE MICRO IS SIMPLY INITIALISATION / FIELD 0 *R8ORG 7000 /NORMAL START IS NOP CLA CLL KCC TLS MBIENT, TAD RCDFI /FETCH CDF INSTRUCTION TAD CRIF /ADD "INSTRUCTION" FIELD DCA MSDFI /SET AS INSTRUCTION / /THE NEXT SECTION OF THE MICRO SEPARATES THE VARIOUS /PARTS OF THE FIRST 12 BITS OF THE MACRO INSTRUCTION / START, CAM /CLEAR HARDWARE AC-MQ CIF CDF 0 /SET DATA AND PROG. FIELD DCA MFLAG /CLEAR MULTIPLY FLAG MLSTRT, CLA CLL /CLEAR AC AND LINK TAD CIWA /FETCH ADDRESS DCA CRIA /SET AS FETCH POINTER ISZ CIWA /ADDRESS + 1 JMS I TVFAIL /CHECK POWER MSDFI, 0 /SET DATA FIELD / /FIRST FETCH 12 BIT WORD / TAD I CRIA /FETCH INSTRUCTION DCA INST /STORE IT / /SEPARATE FIELD BITS / START2, TAD INST /FETCH INSTRUCTION AND MF1 /GET 3 F1 BITS CLL RAL /ROTATE RESULT... RTL /...3 PLACES LEFT DCA F1 /STORE IT TAD INST /FETCH INSTRUCTION AND MF2 /GET 3 F2 BITS DCA F2 /STORE F2 / /THE TWO 6 BIT HALVES OF THE INSTRUCTION /ARE NOW STORED SEPARATELY FOR LATER USE / TAD INST /FETCH INSTRUCTION AND RHM /GET 6 BIT OPCODE BSW /RIGHT JUSTIFY DCA OPCODE /STORE IT TAD INST /FETCH INSTRUCTION AND LHM /MASK OPCODE DCA INSTRH /STORE RIGHT HAND 6 BITS / /NOW SET UP CDF INSTRUCTIONS USING F1 AND F2 / TAD RCDFI /FETCH BASIC CDF INSTRUCTION TAD F1 /COMBINE WITH F1 DCA ARG1F /STORE COMPLETE INSTRUCTION TAD RCDFI /FETCH BASIC CDF INSTRUCTION TAD F2 /COMBINE WITH F2 DCA ARG2F /STORE COMPLETE INSTRUCTION / /CONTENTS OF MACRO 36 BIT ACCUMULATOR ARE NOW SAVED /BEFORE BRANCHING TO THE OPCODE TRANSLATION ROUTINE / TAD ACH /FETCH HIGH ORDER AC DCA ACCH /SAVE IT TAD ACM /FETCH MED ORDER AC DCA ACCM /SAVE IT TAD ACL /FETCH LOW ORDER AC DCA ACCL /SAVE IT JMP I OPTEST /TO TRANSLATION ROUTINE / /THE MICRO PROGRAM IS NOW DIRECTED, VIA A TABLE OF ENTRY /ADDRESSES, TO THE CORRECT INSTRUCTION EXECUTION ROUTINE /AFTER FIRST FETCHING DATA TO A WORK AREA IF NECESSARY / TRANS2, TAD OPCODE /FETCH OPCODE TAD M16 /SUBTRACT 16 SPA CLA /WAS OPCODE < 16? JMS I TVSTOR /YES...GET DATA TRANS1, TAD JMPITB /NO...FETCH TABLE START ADDRESS TAD OPCODE /ADD OPCODE DCA TREXIT /SET EXIT INSTRUCTION CDF /SET DATA FIELD TO ZERO TREXIT, 0 /TO EXECUTION ROUTINE / /LOCAL CONSTANTS...MICRO INTERPRET ROUTINE / OPTEST, TEST1 M16, 0-16 MF1, 0007 MF2, 0070 RHM, 7700 LHM, 0077 JMPITB, JMP I TABLE / /EXECUTION ROUTINES ENTRY ADDRESSES VECTOR / *R8ORG+100 TABLE, NCNR TYPICR PRINTR SIGNR MLTX1R MLTX2R STORXR OCRABR LOADR ADDR SUBTR ADDTOR MDENTR MDENTR STORR IDCWR ANDIMR ORIMR GETR PUTR START START START START GOTOR1
GOSUBR GOPALR LOADXR START YESNOR PRNTCR DREADR TYPER TYPER IMPRUR PRNTXR PRNTWR GIFELR INCGZR DECGZR GOIFZR MOVIMR CLRWDR MOV1R MOV2R MOV3R GOIFQR START CNVRT1 CNVRTR CNVRT1 CNVRTR CNVRT1 CNVRT1 GOWDQR START IMPRUR FILLR START RANGER START START DOVARR DOLOPR / /RASBOL-8 MICRO PROGRAM - TAPE 3 / /THIS SECTION OF THE MICRO TRANSLATES THE OPCODE, WHICH /DETERMINES HOW MANY WORDS THE MACRO INSTRUCTION /OCCUPIES, AND FETCHES THEM TO THE MICRO WORK AREAS / *R8ORG+200 TEST1, RDF /FETCH DATA FIELD DCA CRIF /STORE IT TAD OPCODE /FETCH OPCODE TAD M10 /SUBTRACT 10 SMA CLA /WAS OPCODE < 10? JMP TEST2 /NO...CONTINUE JMP I TR1 /YES...TRANSLATE TEST2, TAD I CIWA /FETCH ARGUMENT TAD X1 /ADD INDEX REGISTER 1 DCA ARG1 /STORE AS 1ST ARGUMENT DCA X1 /CLEAR INDEX REGISTER 1 ISZ CIWA /ADDRESS + 1 TAD OPCODE /FETCH OPCODE TAD M40 /SUBTRACT 40 SMA CLA /WAS OPCODE < 40? JMP TEST3 /NO...CONTINUE JMP I TR2 /YES...TRANSLATE TEST3, TAD I CIWA /FETCH ARGUMENT TAD X2 /ADD INDEX REGISTER 2 DCA ARG2 /STORE AS 2ND ARGUMENT DCA X2 /CLEAR INDEX REGISTER 2 ISZ CIWA /ADDRESS + 1 TAD OPCODE /FETCH OPCODE TAD M60 /SUBTRACT 60 SMA CLA /WAS OPCODE < 60? JMP TEST4 /NO...CONTINUE JMP I TR3 /YES...TRANSLATE TEST4, TAD I CIWA /FETCH LENGTH WORD TAD X3 DCA COUNT /STORE IT DCA X3 ISZ CIWA /ADDRESS + 1 JMP I TR4 /TRANSLATE / /LOCAL CONSTANTS...OPCODE TRANSLATION ROUTINE / TR4, TR3, TR1, TRANS1 TR2, TRANS2 M10, 0-10 M40, 0-40 M60, 0-60 / / SWAM, 0 CAM /CLEAR WORK LOCATIONS / / /SET UP ROUTINE TO SWAP AC - MQ REGISTERS TAD ACH DCA COUNT TAD MQH DCA ACH TAD COUNT DCA MQH TAD ACM DCA COUNT TAD MQM DCA ACM TAD COUNT DCA MQM TAD ACL DCA COUNT TAD MQL DCA ACL TAD COUNT DCA MQL JMP I SWAM / / / /THIS ROUTINE INCREMENTS, DECREMENTS /OR CLEARS A SPECIFIED WORD IN CORE / IDCWR, TAD ARG1F /FETCH CDF INSTRUCTION DCA IDCF /SET IT TAD F2 /FETCH FUNCTION INDICATOR CLL RAR /RIGHT JUSTIFY... RTR /...INDICATOR DCA F2 /STORE IT CLA CLL CMA RAL /SET -2 TAD F2 /ADD INDICATOR SMA SZA CLA /WAS INDICATOR > 2? JMP I TVMOER /YES...TO OBJECT ERROR TAD F2 /NO...FETCH INDICATOR CIA /NEGATE CLL IAC /ADD 1 IDCF, 0 /SET DATA FIELD FOR STORE SNA /IS INSTRUCTION A CLEAR? SZA /YES...TO CLEAR TAD I ARG1 /NO...ADD TO CONSTANT DCA I ARG1 /STORE RESULT JMP I TVMST /EXIT /
/TIME SHARE INPUT WITH PROCESSING TIMESH, KSF/IS ANY KEYS? JMP PFL2/NO EXIT KRB /GET CHAR IFZERO DECWRIT< OSR /*** BIT 8> DCA OBTEM DCA NONPR /TURN OFF TEMP PRINT STOP TAD OBTEM TAD (-203 /CONTR.C SNA JMP ABORTN TAD (-20 /CONTR.S SNA CLA ISZ NONPR TAD I IPPTR /IS BUFFER FULL SZA CLA /NO JMP PFL2 TAD OBTEM DCA I IPPTR TAD IPPTR IAC CLL /INCREMENT BUFFER POINTER AND (7617 DCA IPPTR JMP PFL2 NONPR,0 IPPTR, INBUF /GOZERO,GOPOS,GONEG,GONZRO GOSIGN, TAD F2 TAD (-20 SPA /20,30 JMP IDGOIC SPA SNA CLA /30 JMP GOPOSR /GOPOS,20 TAD ACH SPA CLA JMP GOTOR /GONEG TAD F2 /IS IT 30 OR 40 BSW SMA CLA /40 JMP I TVMST JMP GOPOSR /RASBOL-8 MICRO PROGRAM - TAPE 4 / /THIS SUBROUTINE CONTROLS THE PRINTING OF TEXT STRINGS / *R8ORG+400 PTXSUB, 0 DCA PRNX1 /SET CDF INSTRUCTION PRNX1, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH TWO PACKED CHARACTERS DCA ERS0 /STORE TEMPORARILY CDF /ZERO DATA FIELD FOR CHECK JMS I TVSBUP /UNPACK CHARACTERS TAD ERS1 /FETCH 1ST CHARACTER SNA /WAS IT A NULL? JMP PRX2 /YES...IGNORE IT JMS CHKCH /NO...CHECK FOR SPECIAL CHARACTERS TAD ERS1 /FETCH 1ST CHARACTER DCA ERS0 /STORE IT JMS I TVSBTA /CONVERT TO 8 BIT CODE TAD ERS0 /FETCH CHARACTER JMS I TVPRNT /PRINT IT PRX2, ISZ COUNT /INDEX COUNTER JMP PNXCH /TO PRINT NEXT CHARACTER JMP I PTXSUB /RETURN PNXCH, TAD ERS2 /FETCH 2ND CHARACTER SNA /WAS IT A NULL? JMP PRX3 /YES...IGNORE IT JMS CHKCH /NO...CHECK FOR SPECIAL CHARACTERS TAD ERS2 /FETCH 2ND CHARACTER DCA ERS0 /STORE IT JMS I TVSBTA /CONVERT TO 8 BIT CODE TAD ERS0 /FETCH CHARACTER JMS I TVPRNT /PRINT IT PRX3, ISZ COUNT /INDEX COUNTER JMP PRNX1 /BACK IF NOT LAST JMP I PTXSUB /RETURN / / /THIS ROUTINE PERFORMS A BRANCH /IN THE MACRO PROGRAM GOTOR1, TAD F2 SZA CLA JMP GOSIGN /GOZERO,GOPOS,GONEG,GONZRO GOTOR, CLA CLL TAD F1 /FETCH FIELD DCA CRIF /SET IT TAD ARG1 /FETCH ADDRESS DCA CIWA /SET IT JMP I TVMBNT /TO NEXT INSTRUCTION / / /THIS ROUTINE PERFORMS A SUBROUTINE /JUMP IN THE MACRO PROGRAM / GOSUBR, TAD ARG1F /FETCH CDF INSTRUCTION DCA GS1 /SET IT TAD CRIF /FETCH CURRENT FIELD CLL RAR /RIGHT... RTR /...JUSTIFY TAD KGOTO /ADD "GOTO" INSTRUCTION GS1, 0 /SET DATA FIELD TO STORE DCA I ARG1 /STORE "GOTO" INSTRUCTION ISZ ARG1 /ADDRESS + 1 TAD CIWA /FETCH CURRENT ADDRESS DCA I ARG1 /STORE IT ISZ ARG1 /ADDRESS + 1 JMP GOTOR /TO BRANCH / / /THIS ROUTINE BRANCHES TO A "PAL" SUBROUTINE /EMBEDDED IN A RASBOL-8 PROGRAM / GOPALR, RIF /FETCH CURRENT INSTRUCTION FIELD TAD RCDFI /ADD CDF INSTRUCTION DCA GP1 /SET CDF INSTRUCTION TAD F1 /FETCH F1 TAD KCIF /ADD CIF INSTRUCTION DCA GP2 /SET CIF INSTRUCTION TAD ACL /LOAD ACCU GP1, 0 /CHANGE DATA FIELD GP2, 0 /CHANGE INSTRUCTION FIELD JMS I ARG1 /JUMP TO SUBROUTINE DCA ACL /CONTROL RETURNS HERE TAD RCDFI /FETCH CDF INSTRUCTION TAD CRIF /ADD "INSTRUCTION" FIELD DCA I GPCDFL /RESET INSTRUCTION JMP I TVMST /EXIT / / /THIS ROUTINE PERFORMS A BRANCH IN THE MACRO PROGRAM /IF THE MACRO ACCUMULATOR IS = OR < ZERO / GIFELR, TAD ACH /FETCH HIGH ORDER AC SPA CLA /WAS AC < 0? JMP GLTR /YES...GO TO "<" ADDRESS IDGOIC, CLA CLL /CLEAR AC AND LINK TAD ACH /FETCH HIGH ORDER AC
TAD ACM /ADD MED ORDER AC TAD ACL /ADD LOW ORDER AC SNA CLA /12 BIT AC = 0? SZL /YES...LINK = 0? JMP I TVRAXT /NO...NORMAL EXIT JMP GOTOR /TO BRANCH ROUTINE GLTR, TAD F2 /FETCH FIELD DCA CRIF /SET IT TAD ARG2 /FETCH ADDRESS DCA CIWA /SET IT JMP I TVMBNT /TO NEXT INSTRUCTION / / /THIS ROUTINE INCREMENTS A SPECIFIED /LOCATION AND THEN PERFORMS A BRANCH IN /THE MACRO PROGRAM IF THE LOCATION IS ZERO INCGZR, CLA CLL IAC /=1 JMP GF2 DECGZR, CLA CLL CMA /=-1 JMP GF2 GOIFZR, CLA CLL GF2, DCA COUNT TAD ARG2F DCA .+1 0 TAD COUNT TAD I ARG2 DCA I ARG2 GOIF1, TAD I ARG2 GOIF2, SNA CLA JMP GOTOR JMP I TVMST / / /THIS ROUTINE PERFORMS A BRANCH IN THE MACRO /PROGRAM IF "N" IS TYPED AT THE KEYBOARD / YESNOR, TAD F2 /YESNOR OR ABORT SZA CLA JMP ABORTI JMS I TVOBTN /FETCH CHARACTER DCA ERS0 /STORE IT TAD ERS0 /FETCH CHARACTER JMS I TVPRNT /PRINT IT JMS I TVCMPA /COMPARE... ERS0 /...CHARACTER... 331 /...WITH ASCII Y SNA CLA /WAS IT Y? JMP I TVMST /YES...EXIT JMS I TVCMPA /NO...COMPARE... ERS0 /...CHARACTER... 316 /...WITH ASCII N SZA CLA /WAS IT N? JMP YESNOR /NO...INCORRECT RESPONSE JMP GOTOR /YES...TO BRANCH ROUTINE / /CONSTANTS...BRANCH ROUTINES / GPCDFL, MSDFI KCIF, 6202 KGOTO, 3000 / /RASBOL-8 MICRO PROGRAM - TAPE 5 / /SUBROUTINE TO CONVERT A SINGLE 6 BIT /CHARACTER TO A SINGLE 8 BIT CHARACTER / *R8ORG+600 SBTA, 0 CLA CLL TAD ERS0 /FETCH CHARACTER SNA /WAS IT A NULL? JMP I SBTA /YES...IGNORE IT TAD SBM40 /NO...SUBTRACT 40 SPA CLA /WAS IT > OR = 40? TAD SB100 /NO...SET 100 TAD SB200 /YES...ADD 200 TAD ERS0 /ADD CHARACTER DCA ERS0 /STORE 8 BIT CODE JMP I SBTA /RETURN / /CONSTANTS...CONVERT TO 8 BIT ROUTINE / SB100, 100 SB200, 200 SBM40, 0-40 / / /THIS ROUTINE PRINTS A TEXT STRING WHICH FOLLOWS /IMMEDIATELY AFTER THE MACRO "PRINT" INSTRUCTION / PRINTR, CAM /CLEAR WORK AREAS TAD INSTRH /FETCH NUMBER CIA /NEGATE IT DCA COUNT /SET AS COUNTER TAD CRIA /FETCH ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD CRIF /FETCH DATA FIELD TAD RCDFI /COMBINE WITH CDF INSTRUCTION PRNXJS, JMS PTXSUB /TO PRINT STRING TAD OPCODE /FETCH OPCODE CLL RAR /OBTAIN RIGHTMOST BIT SZL /WAS OPCODE 2? JMP I TVMST /NO...EXIT CLA CLL IAC /YES...SET 1 TAD IR1 /ADD ADDRESS DCA CIWA /RESET INSTRUCTION ADDRESS JMP I TVMST /EXIT / / /THIS ROUTINE PRINTS A TEXT STRING STARTING FROM A /CORE LOCATION SPECIFIED IN THE MACRO INSTRUCTION / PRNTXR, CLA CLL CMA /SET -1 TAD ARG1 /ADD ARG1 ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD ARG2 /FETCH NO OF CHARACTERS CIA /NEGATE DCA COUNT /SET AS COUNTER TAD ARG1F /FETCH CDF INSTRUCTION JMP PRNXJS /TO PRINT ROUTINE / / /SUBROUTINE TO COMPLEMENT A 36 BIT REGISTER / COMP, 0 CLA CLL IAC /SET AC = 1 TAD I COMP /ADD HIGH ORDER ADDRESS DCA ERS1 /GIVES MED ORDER ADDRESS CLA CLL IAC /SET AC = 1 TAD ERS1 /ADD MED ORDER ADDRESS DCA ERS0 /GIVES LOW ORDER ADDRESS TAD I ERS0 /LOW ORDER WORD TO AC CIA /MAKE NEGATIVE DCA I ERS0 /RESTORE TO LOW ORDER WORD GLK /FETCH OVERFLOW BIT DCA ERS0 /SAVE OVERFLOW BIT TAD I ERS1 /MED ORDER WORD TO AC CMA /COMPLEMENT IT TAD ERS0 /ADD OVERFLOW BIT DCA I ERS1 /RESTORE TO MED ORDER WORD GLK /FETCH OVERFLOW BIT DCA ERS0 /SAVE OVERFLOW BIT TAD I COMP /FETCH HIGH ORDER ADDRESS DCA ERS1 /AND STORE IT TAD I ERS1 /HIGH ORDER WORD TO AC CMA /COMPLEMENT IT TAD ERS0 /ADD OVERFLOW BIT DCA I ERS1 /RESTORE TO HIGH ORDER WORD ISZ COMP /INDEX OVER ARGUMENT JMP I COMP /RETURN / /
/ /THIS SUBROUTINE TESTS FOR SPECIAL CHARACTERS /IN A 6 BIT STRING AND REPLACES THEM AS REQUIRED / CHKCH, 0 DCA ERS0 /STORE CHARACTER JMS I TVCMPA /COMPARE... ERS0 /...CHARACTER... 36 /...WITH "UP ARROW" SZA CLA /WAS IT "UP ARROW"? JMP CHKBA /NO...TEST FOR "BACK ARROW" TAD CHKTAB /YES...FETCH "TAB" CHARACTER CHKXT1, DCA ERS0 /STORE IT CLA CLL CML IAC RAL /SET 3 TAD CHKCH /ADD RETURN ADDRESS DCA CHKCH /RESET IT JMP I CHKCH /RETURN CHKBA, JMS I TVCMPA /COMPARE... ERS0 /...CHARACTER... 37 /...WITH "BACK ARROW" SZA CLA /WAS IT "BACK ARROW"? JMP I CHKCH /NO...RETURN TAD CHKCR /YES...FETCH CARRIAGE RETURN JMS I TVPRNT /PRINT IT TAD CHKLF /FETCH LINE FEED JMP CHKXT1 /TO EXIT / /CONSTANTS...CHECK SPECIAL CHARACTERS ROUTINE / CHKTAB, IFZERO DECWRIT<211 /TAB> IFNZRO DECWRIT<240 /SPACE> CHKLF, 212 CHKCR, 215 / / /THIS ROUTINE FILLS A SPECIFIED NUMBER OF SUCCESSIVE /LOCATIONS WITH A SPECIFIED 12 BIT PATTERN / FILLR, FILLR2, TAD COUNT /FETCH NO OF WORDS CIA /NEGATE DCA COUNT /SET AS COUNTER JMS I TVCLR /TO CLEAR ROUTINE JMP I TVMST /EXIT /OBTAIN THE NEXT CHAR. FROM THE INPUT BUFFER /AND RETURN IN THE HW.AC OBTN, 0 WKF, JMS I TVFAIL TAD I IBPTR /GET FROM BUFFER SNA /ANY? JMP WKF /NO,WAIT DCA OBTEM DCA I IBPTR /CLEAR FROM BUFFER TAD IBPTR IAC CLL /INCREMENT POINTER AND (7757 DCA IBPTR TAD OBTEM /GET FROM TEMP JMP I OBTN /RETURN IBPTR, INBUF / / OBTEM, 0 / / /THIS SUBROUTINE SETS UP ARGUMENTS FOR THE /"IMAGE" AND "PRINTU" EXECUTION ROUTINES / SETVEC, 0 CIA /NEGATE NUMBER IN AC DCA COUNT /SET AS COUNTER TAD COUNT /FETCH COUNT (-VE) TAD SVTS2E /ADD VECTOR ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 JMP I SETVEC /RETURN / /CONSTANTS...ARGUMENT SET UP ROUTINE / SVTS2E, TS2E / /RASBOL-8 MICRO PROGRAM - TAPE 6 / /SUBROUTINE TO ADD THE 36 BIT ACCUMULATOR TO EITHER /THE 36 BIT SR REGISTER OR THE 36 BIT SR1 REGISTER /DEPENDING ON THE VALUE TO WHICH A SOFTWARE FLAG IS SET / *R8ORG+1000 ADDS, 0 CLA CLL TAD SFLAG /FETCH FLAG SZA CLA /WAS IT ZERO? JMP SETSR1 /NO...SET FOR SR1 /SET TO ADD SR TO AC TAD ACL TAD SRL DCA ACL GLK TAD ACM TAD SRM DCA ACM GLK TAD SRH JMP ADDS2 SETSR1, TAD ACL TAD SR1L DCA ACL GLK TAD ACM TAD SR1M DCA ACM GLK TAD SR1H ADDS2, TAD ACH DCA ACH JMP I ADDS / / /SUBROUTINE TO MOVE NUMBERS BETWEEN MACRO /DATA STORE AND MICRO AC AND SR REGISTERS / /THE SUBROUTINE OPERATES ACCORDING TO THE /VALUE OF A SOFTWARE FLAG:- / FLAG = 0 : MACRO ARG1 TO MICRO SR / " = 1 : MICRO AC TO MACRO ARG1 / STORER, 0 CLA CLL / /TEST FOR ZERO PRECISION / TAD F2 /FETCH NO OF WORDS CLL RAR /ROTATE THREE... RTR /...PLACES RIGHT SNA /IS NO OF WORDS ZERO? JMP STCHK /YES...CHECK IF CORRECT DCA STKNT /NO...STORE NUMBER / /NOW TEST FOR OBJECT ERROR / CLA CLL CMA RTL /SET -3 TAD STKNT /ADD NUMBER SMA SZA CLA /WAS NUMBER > 3? JMP I TVMOER /YES...TO OBJECT ERROR / /FLAG IS FETCHED AND TESTED TO DETERMINE /WHICH OPERATION THE ROUTINE IS TO PERFORM / TAD SFLAG /NO...FETCH FLAG SNA CLA /IS IT ZERO? JMP SET1 /YES...SET FOR A1 TO SR / /SET UP ROUTINE TO MOVE MICRO AC TO MACRO ARG1 / TAD STACL /NO...FETCH AC ADDRESS DCA STADD /STORE IT CLA CLL CMA /SET -1 TAD STKNT /ADD NO OF WORDS TAD ARG1 /ADD ADDRESS DCA STCON /STORE IT TAD RCDFI /FETCH CDF INSTRUCTION DCA STRLP /SET IT TAD ARG1F /FETCH CDF INSTRUCTION DCA STRLP1 /SET IT JMP SET /CONTINUE / /SET UP ROUTINE TO MOVE MACRO ARG1 TO MICRO SR
/ SET1, DCA SRH /CLEAR 36 BIT SR DCA SRM DCA SRL CLA CLL CMA /SET -1 TAD STKNT /ADD NO OF WORDS TAD ARG1 /ADD ADDRESS DCA STADD /STORE IT TAD STSRL /FETCH SR ADDRESS DCA STCON /STORE IT TAD ARG1F /FETCH CDF INSTRUCTION DCA STRLP /SET IT TAD RCDFI /FETCH CDF INSTRUCTION DCA STRLP1 /SET IT / /NOW SET UP TRANSFER LOOP / SET, TAD STKNT /FETCH NO OF WORDS CIA /NEGATE DCA STKNT /SET AS COUNTER / /THIS IS THE TRANSFER LOOP / STRLP, 0 /SET DATA FIELD TO FETCH TAD I STADD /FETCH DATA STRLP1, 0 /SET DATA FIELD TO STORE DCA I STCON /STORE DATA CDF /SET DATA FIELD TO ZERO JMS I TVPDPR /UPDATE FETCH POINTER STADD JMS I TVPDPR /UPDATE STORE POINTER STCON ISZ STKNT /INDEX COUNTER JMP STRLP /BACK IF NOT LAST JMP I STORER /RETURN / /IF NO OF WORDS IS ZERO CHECK TO SEE IF ZERO IS ALLOWED / STCHK, TAD OPCODE /FETCH OPCODE TAD SKM13 /SUBTRACT 13 SNA CLA /WAS OPCODE 13? JMP I STORER /YES...RETURN TAD OPCODE /NO...FETCH OPCODE TAD SKM16 /SUBTRACT 16
SMA CLA /WAS OPCODE 16? JMP I STORER /YES...RETURN / /IF ZERO IS ALLOWED THEN INSTRUCTION IS /"IMMEDIATE" AND A CONSTANT IS FETCHED / TAD ARG1 /NO...FETCH CONSTANT DCA SRL /PLACE IN SR TAD INSTRH DCA SRM DCA SRH JMP I STORER /RETURN / /CONSTANTS...FETCH DATA ROUTINE / STACL, ACL STSRL, SRL SKM13, 0-13 SKM16, 0-16 STADD, 0 STCON, 0 STKNT, 0 / / /THIS ROUTINE IS USED TO PERFORM THE LOAD AND /ADD FUNCTIONS, OPERATING ON THE 36 BIT AC / LOADR, JMS I TVCLAM /CLEAR AC - MQ REGISTERS ADDR, DCA SFLAG /CLEAR FLAG JMS I TVADDS /ADD SR TO AC JMP I TVMST /EXIT / / /THIS ROUTINE PERFORMS SUBTRACTION / SUBTR, JMS I TVCOMP /COMPLEMENT SR SRH JMP ADDR /FINISH AS FOR ADD /GOIFEQ INSTR. GO IF ACC. = ARG2 GOIFQR, CLA CLL TAD ACH TAD ACM SNA SZL CLA JMP I TVMST TAD ACL CIA TAD ARG2 JMP GOIF2 / /GOWDEQ. GO IF WD. = LIT. GOWDQR, TAD ARG2F DCA .+1 0 TAD COUNT CIA JMP GOIF1 / / /RASBOL-8 MICRO PROGRAM - TAPE 7 / /TRIPLE PRECISION DIVIDE ROUTINE / *R8ORG+1200 TDIV, 0 CLA CLL DCA DSGN /SET SIGN OF RESULT SWITCH / /NOW CHECK SIGNS OF EVERYTHING / TAD ACH /FETCH HIGH ORDER AC SMA /IS IT NEGATIVE? JMP NNA /NO...CONTINUE ISZ DSGN /YES...SET SIGN SWITCH JMS C72 /COMPLEMENT 72 BIT AC-MQ NNA, CLA CLL TAD SRH /FETCH HIGH ORDER SR DCA SR1H /STORE IN HIGH ORDER SR1 TAD SRM /FETCH MED ORDER SR DCA SR1M /STORE IN MED ORDER SR1 TAD SRL /FETCH LOW ORDER SR DCA SR1L /STORE IN LOW ORDER SR1 TAD SRH /FETCH HIGH ORDER SR SMA /IS IT NEGATIVE? JMP NNSR /NO...COMPLEMENT SR1 ISZ DSGN /YES...SET SIGN SWITCH JMS I TVCOMP /COMPLEMENT SR SRH JMP INDL /TO DIVIDE LOOP NNSR, JMS I TVCOMP /COMPLEMENT SR1 IF +VE SR1H INDL, TAD DM36 /PLACE -36 DCA DSHC /IN SHIFT COUNTER / /THIS BEGINS THE ACTUAL DIVIDE / /FIRST SHIFT AC-MQ LEFT 1 PLACE / DLP, JMS I TVFAIL /CHECK FOR POWER DOWN CLA CLL CML /SET LINK = 1 TAD DM6 /PUT -6 DCA ERS0 /IN INDEX LOCATION TAD AMQLD /PUT ADDRESS OF LOW ORDER MQ DCA ERS1 /IN ADDRESS INDEX LOCATION / DLP1, CLA CML TAD I ERS1 /FETCH WORD FROM 72 BIT REGISTER RAL /SHIFT LEFT 1 DCA I ERS1 /RESTORE TO 72 BIT REGISTER
CLA CMA / -1 TAD ERS1 / + ADDRESS DCA ERS1 /GIVES NEW ADDRESS ISZ ERS0 /INDEX ON NO OF WORDS JMP DLP1 /BACK IF NOT FINISHED / /CHECK TO SEE IF AC > OR = SR / CLA CLL TAD SRH /FETCH HIGH ORDER SR CIA /MAKE NEGATIVE TAD ACH /ADD HIGH ORDER AC SNA /IS RESULT ZERO? JMP DLP2 /YES...MORE TESTS SMA /NO...IS AC > SR? JMP SBTC /YES...GO TO SUBTRACT JMP INDX /NO...GO TO INDEX SHIFT COUNTER DLP2, CLA CLL TAD SRM /FETCH MED ORDER SR CMA CML IAC /NEGATE; USE LINK AS 13 BIT AC TAD ACM /ADD MED ORDER AC SNA /RESULT ZERO? JMP DLP3 /YES...MORE TESTS SNL /LINK IS SIGN; IS AC > SR? JMP SBTC /YES...GO TO SUBTRACT JMP INDX /NO...GO TO INDEX SHIFT COUNTER DLP3, CLA CLL TAD SRL /FETCH LOW ORDER SR CMA CML IAC /NEGATE; USE LINK AS 13 BIT AC TAD ACL /ADD LOW ORDER AC SZL /LINK IS SIGN; IS AC > OR = SR? JMP INDX /NO...INDEX SHIFT COUNTER / /NOW SUBTRACT SR FROM AC / SBTC, CLA CLL IAC /SET 1... DCA SFLAG /...IN FLAG JMS I TVADDS /ADD SR1 TO AC DCA SFLAG /CLEAR FLAG ISZ MQL /LOW MQ + 1; ACCOUNTS FOR DIVISION INDX, ISZ DSHC /INDEX SHIFT COUNTER JMP DLP /BACK IF NOT FINISHED / /DIVISION COMPLETE...NOW CHECKT / CLA CLL TAD DSGN /FETCH SIGN SWITCH RAR /SHIFT RIGHT 1 SNL /WAS IT ODD? JMP I TDIV /NO...RESULT +VE...EXIT JMS I TVCOMP /YES...COMPLEMENT RESULT MQH JMP I TDIV /RETURN / /LOCAL CONSTANTS...DIVIDE ROUTINE / DM6, 0-6 DM3, 0-3 DM36, 0-44 AMQLD, MQL DSHC, 0 DSGN, 0 / / /SUBROUTINE TO TRANSFER A VECTOR /FROM ONE PART OF CORE TO ANOTHER / BTR, 0 CLA CLL TAD ARG1F /FETCH CDF INSTRUCTION DCA BTR1 /SET IT TAD ARG2F /FETCH CDF INSTRUCTION DCA BTR2 /SET IT BTR0, BTR1, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH WORD BTR2, 0 /SET DATA FIELD TO STORE DCA I IR2 /STORE WORD ISZ COUNT /INDEX COUNTER JMP BTR0 /BACK IF NOT LAST JMP I BTR /RETURN / / MLTX, 0 DCA ARG2 TAD INSTRH SNA /0? TAD ACL CIA DCA COUNT TAD ARG2 ISZ COUNT JMP .-2 JMP I MLTX /THIS ROUTINE MULTIPLIES MACRO INDEX /REGISTER 1 BY A SPECIFIED CONSTANT / MLTX1R, TAD X1 JMS MLTX DCA X1 JMP I TVMST /EXIT / / /THIS ROUTINE MULTIPLIES MACRO INDEX /REGISTER 2 BY A SPECIFIED CONSTANT / MLTX2R, TAD X2 JMS MLTX DCA X2
JMP I TVMST /EXIT / / /RASBOL-8 MICRO PROGRAM - TAPE 8 / /TRIPLE PRECISION MULTIPLY ROUTINE / *R8ORG+1400 TMPY, 0 CLA CLL DCA SIGN /ZERO SIGN OF RESULT SWITCH DCA ACH /CLEAR 36 BIT AC. DCA ACM DCA ACL TSMQ, TAD MQH /FETCH HIGH ORDER MQ SMA /IS IT NEGATIVE? JMP TSSR /NO...CONTINUE ISZ SIGN /YES...SET SIGN SWITCH JMS I TVCOMP /COMPLEMENT MQ MQH TSSR, CLA CLL TAD SRH /FETCH HIGH ORDER SR SMA /IS IT NEGATIVE? JMP STLP /NO...CONTINUE ISZ SIGN /YES...SET SIGN SWITCH JMS I TVCOMP /COMPLEMENT SR SRH STLP, CLA CLL /INITIALISE MULTIPLICATION LOOP TAD M36 /PLACE -36 IN DCA SHCT /SHIFT COUNTER / /THIS IS THE MULTIPLICATION LOOP / MLP, CLA CLL JMS I TVFAIL /CHECK FOR POWER DOWN TAD MQL /FETCH LOW ORDER MQ RAR /OBTAIN RIGHTMOST BIT SNL /WAS IT A 1? JMP SHFT /NO...JUST SHIFT CLA CLL /YES...CLEAR AC AND LINK DCA SFLAG /CLEAR FLAG JMS I TVADDS /ADD SR TO AC / /NOW SHIFT AC AND MQ RIGHT ONE PLACE AS A 72 BIT REGISTER / SHFT, CLA CLL DCA ERS0 /ZERO SHIFTED BIT LOCATION TAD AACH /SET ADDRESS OF HIGH ORDER AC DCA IR1 / -1 IN AUTO INDEX REGISTER 1 TAD AACH /AND ALSO TO DCA IR2 /AUTO INDEX REGISTER 2 TAD M6 /FETCH -6 DCA ERS1 /STORE AS INDEX GETW, TAD I IR1 /FETCH WORD RAR /SHIFT RIGHT 1 TAD ERS0 /ADD BIT SHIFTED OUT OF LAST DCA I IR2 /WORD TO SAME WORD RAR /LINK TO HIGH ORDER AC DCA ERS0 /TO SHIFTED BIT LOCATION ISZ ERS1 /INCREMENT NO OF WORDS JMP GETW /BACK IF NOT FINISHED ISZ SHCT /ADD 1 TO SHIFT COUNTER JMP MLP /BACK IF NOT LAST / /MULTIPLICATION OVER...NOW SET SIGN OF RESULT / CLA CLL TAD SIGN /FETCH SIGN SWITCH RAR /SHIFT RIGHT 1 SNL /WAS IT AN ODD NO? JMP I TMPY /NO...RETURN WITH AC-MQ +VE JMS C72 /YES...COMPLEMENT 72 BIT PROD. JMP I TMPY /RETURN WITH AC-MQ -VE / / /SUBROUTINE TO COMPLEMENT AC AND MQ AS ONE 72 BIT REGISTER / C72, 0 CLA CLL TAD M6 /PLACE -6 DCA ERS0 /IN AN INDEX LOCATION TAD AMQL /PLACE LOW ORDER MQ ADDRESS DCA ERS1 /IN CURRENT REGISTER LOCATION TAD MQL /FETCH LOW ORDER MQ NEG, CIA /MAKE NEGATIVE JMP ENTL /THEN ENTER LOOP IN MIDDLE / C72L, CLA CMA CLL CML / -1 TAD ERS1 / + ADDRESS OF CURRENT REGISTER DCA ERS1 /IS NEW ADDRESS TAD I ERS1 /FETCH CURRENT REGISTER CMA /COMPLEMENT IT TAD SIGN /ADD OVERFLOW BIT
ENTL, DCA I ERS1 /RESTORE TO REGISTER GLK /FETCH OVERFLOW BIT DCA SIGN /STORE IT ISZ ERS0 /INDEX ON NO OF REGISTERS JMP C72L /RETURN FOR MORE JMP I C72 /RETURN WITH AC-MQ -VE / /LOCAL CONSTANTS...MULTIPLY ROUTINE / M6, 0-6 M36, 0-44 AACH, ACH-1 AMQL, MQL SHCT, 0 SIGN, 0 / / /SUBROUTINE TO CONVERT A 36 BIT BINARY NUMBER /INTO A STRING OF 8 BIT ASCII CHARACTERS / CBCH, 0 CLA CLL TAD CBVA /FETCH VECTOR END ADDRESS DCA CDP /SET AS COUNT DOWN POINTER TAD CB10 /FETCH 10 DCA SRL /SET IN SR DCA SRM DCA SRH CDF /SET DATA FIELD TO 0 CLPB, TAD MQH /FETCH HIGH ORDER MQ TAD MQM /ADD MED ORDER MQ TAD MQL /ADD LOW ORDER MQ SNA CLA /12 BIT AC ZERO? SZL /YES...IS LINK ZERO? SKP /NO...CONTINUE CONVERSION JMP I CBCH /YES...RETURN DCA ACH /ZERO 36 BIT AC DCA ACM DCA ACL JMS I TVTDIV /DIVIDE NO BY 10 TAD ACL /FETCH REMAINDER TAD CB260 /ADD 8 BIT ASCII CODE DCA I CDP /STORE IN VECTOR JMS I TVPDPR /UPDATE COUNT DOWN POINTER CDP JMP CLPB /CONTINUE CONVERSION / /CONSTANTS...BINARY TO CHARACTER CONVERSION ROUTINE / CBVA, TSE CB10, 12 CB260, 260 CDP, 0 / / /THE NEXT ROUTINE PERFORMS BOTH /THE ADDTO AND STORE FUNCTIONS / ADDTOR, CLA DCA SFLAG /CLEAR FLAG JMS I TVADDS /ADD SR TO AC STORR, CLA CLL IAC /SET 1... DCA SFLAG /...IN FLAG JMS I TVSTOR /PLACE AC IN ARG1 DCA SFLAG /CLEAR FLAG RAEXIT, TAD ACCH /FETCH HIGH ORDER AC DCA ACH /RESET IT TAD ACCM /FETCH MED ORDER AC DCA ACM /RESET IT TAD ACCL /FETCH LOW ORDER AC DCA ACL /RESET IT JMP I TVMST /EXIT / /RASBOL-8 MICRO PROGRAM - TAPE 9 / /SUBROUTINE TO UPDATE A "PUSH DOWN POINTER" / *R8ORG+1600 PDPR, 0 TAD I PDPR /FETCH ARGUMENT DCA PDSP /STORE IT CLA CLL CMA /SET -1 TAD I PDSP /ADD COUNTER DCA I PDSP /STORE NEW COUNTER VALUE ISZ PDPR /INDEX FOR RETURN CLA CLL JMP I PDPR /RETURN / /CONSTANTS...POINTER UPDATE ROUTINE / PDSP, 0 / / /THESE ROUTINES PERFORM VARIOUS CONVERSIONS / /THIS NEXT ROUTINE SETS UP THE APPROPRIATE /CONVERSION ROUTINE ARGUMENTS / CNVRTR, JMS I TVCLAM /CLEAR AC - MQ CNVRT1, TAD OPCODE /FETCH OPCODE TAD (-62 /SUBTRACT 62 SPA CLA /WAS OPCODE > 61? JMP I CNVBR /NO...TO BINARY CONVERSIONS CLA CLL CMA /YES...SET -1 TAD ARG1 /ADD ARG1 DCA IR1 /SET IN AUTO INDEX REGISTER 1 CLA CLL CMA /SET -1 TAD ARG2 /ADD ARG2 DCA IR2 /SET IN AUTO INDEX REGISTER 2 TAD COUNT /FETCH LENGTH
CIA /NEGATE DCA COUNT /SET AS COUNTER TAD OPCODE /FETCH OPCODE TAD (-62 /SUBTRACT 62 TAD (JMP I LIST1 /ADD "JMP" INSTRUCTION DCA .+1 /SET INSTRUCTION 0 /BRANCH TO ROUTINE LIST1, MOVETR /MOVE...OPCODE 62 CMPARE /COMPARE...OPCODE 63 CNV6WR /CONVERT FROM 6 BIT...OPCODE 64 CNVW6R /CONVERT TO 6 BIT...OPCODE 65 / CNVWHR /CONVERT TO HANDLER...OPCODE 66 / CNVHWR /CONVERT FROM HANDLER...OPCODE 67 / / / /THE NEXT ROUTINE COPIES A VECTOR /FROM ONE PART OF CORE TO ANOTHER / MOVETR, JMS I TVBTR /TO SHIFT VECTOR JMP I TVMST /EXIT / / /THIS ROUTINE CONVERTS 6 BIT CHARACTERS STORED TWO /PER WORD TO 8 BIT CHARACTERS STORED ONE PER WORD / CNV6WR, TAD ARG1F /FETCH CDF INSTRUCTION DCA CN6W1 /SET IT TAD ARG2F /FETCH CDF INSTRUCTION DCA CN6W2 /SET IT CN6W1, 0 /SET DATA FIELD FOR FETCH TAD I IR1 /FETCH TWO PACKED CHARACTERS DCA ERS0 /STORE THEM JMS I TVSBUP /UNPACK CHARACTERS CN6W2, 0 /SET DATA FIELD FOR STORE TAD ERS1 /FETCH CHARACTER DCA ERS0 /STORE IT JMS I TVSBTA /CONVERT TO 8 BIT CODE TAD ERS0 /FETCH CHARACTER DCA I IR2 /STORE IT TAD ERS2 /FETCH CHARACTER DCA ERS0 /STORE IT JMS I TVSBTA /CONVERT TO 8 BIT CODE TAD ERS0 /FETCH CHARACTER DCA I IR2 /STORE IT ISZ COUNT /INDEX COUNTER JMP CN6W1 /BACK IF NOT LAST JMP I TVMST /EXIT / /CONSTANTS..."CNVRT" ROUTINE / CNVBR, CNVBST / /AND IMMIDEATE ,OR IMMEDIATE INSTRUCTION ANDIMR, CLA CLL TAD ACL AND ARG1 ANDIM2, DCA ACL JMP I TVMST ORIMR, CAM TAD ACL MQL /PUT IN HW MQ TAD ARG1 MQA /OR JMP ANDIM2 /PRINT OCTAL ROUTINE PRNTOR, TAD ACL JMS PROCT JMP I TVMST /MOVE IMMEDEATE MOVIMR, CLA IAC /1 MOVR2, DCA COUNT JMP FILLR2 /RASBOL BYTE SWAP RBSWR, TAD ACL BSW JMP ANDIM2 /CLEAR WORDS CLRWDR, TAD ARG1 DCA COUNT DCA ARG1 /0 JMP FILLR2 /MOVE ONE,TWO,THREE WORDS MOV3R, IAC MOV2R, IAC MOV1R, IAC MOVTR, DCA COUNT TAD (62 /MOVE INSTR DCA OPCODE JMP CNVRT1 /EXECX3, EXECUTE CONTENTS OF X3 AS AN INSTRUCTION EXEC3R, TAD X3 DCA INST DCA X3 TAD MSDFI /RESET DATA FLD DCA .+1 PFCKNT, 0 JMP START2 GOPOSR, CLA CLL TAD ACH SPA GPS2, JMP I TVMST /NEGATIVE TAD ACM TAD ACL SZA JMP GOTOR SZL JMP GOTOR JMP GPS2 /ZERO / LINACR, JMS I TVCLAM TAD LINKNT JMP ANDIM2 / /SUBROUTINE TO PRINT 6 "FILL" CHARACTERS. USED /WHENEVER OUTPUT IS TO "TERMINET" TELEPRINTER / PRFLCH, 0 CLA CLL TAD PFCM6 /FETCH -4 DCA PFCKNT /SET AS COUNTER PFC1, JMS I TVPRCH /PRINT NULL ISZ PFCKNT /INDEX COUNTER JMP PFC1 /BACK IF NOT LAST JMP I PRFLCH /RETURN / /CONSTANTS...PRINT FILL CHARACTERS ROUTINE / PFCM6, 0-4 / / / /RASBOL-8 MICRO PROGRAM - TAPE 10 / / *R8ORG+2000 / / /SUBROUTINE TO CLEAR STORAGE VECTORS WITH BLANKS / CBSV, 0 CLA CLL TAD RCDFI /FETCH CDF INSTRUCTION DCA ARG1F /SET IT TAD RCDFI /FETCH CDF INSTRUCTION DCA ARG2F /SET IT TAD CV240 /FETCH ASCII BLANK DCA ARG1 /SET AS ARG1 TAD CVBTS /FETCH ADDRESS DCA ARG2 /SET AS ARG2 TAD CM52 /FETCH -52 DCA COUNT /SET AS COUNTER JMS I TVCLR /CLEAR VECTORS JMP I CBSV /RETURN / /CONSTANTS...CLEAR VECTORS ROUTINE / CVBTS, TS CM52, 0-52 CV240, 240 / / /SUBROUTINE TO CLEAR BOTH THE 36 BIT ACCUMULATOR /AND THE 36 BIT MULTIPLIER QUOTIENT TO ZERO / CLAM, 0 CLA CLL DCA ACH /ZERO 36 BIT AC DCA ACM DCA ACL DCA MQH /ZERO 36 BIT MQ DCA MQM DCA MQL JMP I CLAM /RETURN / / /THIS SUBROUTINE PLACES A 12 BIT PATTERN /INTO SUCCESSIVE CORE STORAGE LOCATIONS / CLR, 0 CLA CLL TAD ARG2F /FETCH CDF INSTRUCTION DCA CLR1 /SET IT CLA CLL CMA /SET -1 TAD ARG2 /ADD ARG2 ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 CLRSLP, TAD ARG1 /FETCH BIT PATTERN CLR1, 0 /SET DATA FIELD TO STORE DCA I IR1 /STORE BIT PATTERN ISZ COUNT /INDEX COUNTER
JMP CLRSLP /BACK IF NOT LAST JMP I CLR /RETURN
/ / /SUBROUTINE TO GOVERN THE PRINTING OF SINGLE /ASCII CHARACTERS. THE ROUTINE TESTS EACH /CHARACTER FOR A "LINE FEED" AND INSERTS 8 /"FILL" CHARACTERS INTO THE OUTPUT STRING / PRNT, 0 DCA PRTCS /STORE CHARACTER TAD PRTCS /FETCH CHARACTER SZA /IGNORE ZERO JMS I TVPRCH /PRINT IT JMS I TVCMPA /COMPARE... PRTCS /...CHARACTER... 212 /...WITH LINE FEED SZA CLA /WAS IT LINE FEED? JMP I PRNT /NO...RETURN IFZERO DECWRIT< JMS PRFLCH> /YES...PRINT FILL CHARACTERS IFZERO ODTRUN < ISZ LINKNT /ADD 1 TO LINE COUNT> IFNZRO ODTRUN < 7000 /NO OPERATION> JMP I PRNT /RETURN / /CONSTANTS...PRINT CONTROL ROUTINE / PRTCS, 0 / / /SUBROUTINE TO UNPACK 6 BIT ASCII CHARACTERS, STORED /TWO PER WORD, AND STORE EACH IN A SINGLE WORD / SBUP, 0 CLA CLL TAD ERS0 /FETCH 2 PACKED CHARACTERS BSW /RIGHT JUSTIFY RESULT AND ULHM /MASK RIGHT HAND 6 BITS DCA ERS1 /STORE CHARACTER TAD ERS0 /FETCH 2 PACKED CHARACTERS AND ULHM /MASK LEFT HAND 6 BITS DCA ERS2 /STORE CHARACTER JMP I SBUP /RETURN / /CONSTANTS...UNPACK ROUTINE ULHM, 0077 / / /THIS ROUTINE LOADS THE MACRO INDEX REGISTERS / LOADXR, TAD ARG1F DCA .+1 0 TAD I ARG1 JMP STORX / / /THIS ROUTINE LOADS THE CONTENTS OF THE LOW ORDER /WORD OF THE MACRO ACCUMULATOR INTO A MACRO INDEX /REGISTER INDICATED BY THE VALUE OF THE F2 BITS / STORXR, TAD ACL STORX, DCA COUNT TAD F2 /FETCH F2 CLL RTR /RIGHT.2. TAD (JMP .+2 DCA .+2 TAD COUNT 0 DCA X1 JMP I TVMST DCA X2 JMP I TVMST DCA X3 JMP I TVMST DCA LINKNT JMP I TVMST CLA CLL JMP .-3 / / /THIS ROUTINE PRINTS A STRING OF CHARACTERS / PRNTWR, TAD ARG1F /FETCH CDF INSTRUCTION DCA PRW1 /SET IT CLA CLL CMA /SET -1 TAD ARG1 /ADD ARG1 ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD ARG2 /FETCH NO OF CHARACTERS CIA /NEGATE DCA COUNT /SET AS COUNTER PRW1, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH CHARACTER JMS I TVPRNT /PRINT IT ISZ COUNT /INDEX COUNTER JMP PRW1 /BACK IF NOT LAST JMP I TVMST /EXIT /
/RASBOL-8 MICRO PROGRAM - TAPE 11 / /THIS SECTION OF THE MICRO SETS UP THE CONVERSIONS /INVOLVING BOTH ASCII CHARACTERS AND 36 BIT BINARY / *R8ORG+2200 CNVBST, TAD COUNT /FETCH LENGTH TAD CM13 /SUBTRACT 13 SMA SZA CLA /WAS LENGTH > 13? JMP I TVMOER /YES...TO OBJECT ERROR TAD ARG1F /NO...FETCH CDF INSTRUCTION DCA SV1 /SAVE IT TAD ARG2F /FETCH CDF INSTRUCTION DCA SV2 /SAVE IT TAD ARG1 /FETCH ARG1 DCA SV3 /SAVE IT TAD ARG2 /FETCH ARG2 DCA SV4 /SAVE IT TAD COUNT /FETCH LENGTH DCA SV5 /SAVE IT JMS I TVCBSV /CLEAR STORAGE VECTORS CLA CLL CML IAC RAL /SET 3 TAD CBSM63 /SUBTRACT 63 TAD OPCODE /ADD OPCODE SNA CLA /WAS OPCODE 60? JMP CNVBWR /YES...CONVERT FROM BINARY / /THE NEXT ROUTINE CONVERTS AN ASCII /STRING INTO A 36 BIT BINARY NUMBER / CNVWBR, CLA CLL CMA /NO...SET -1 TAD SV3 /ADD ARG1 ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD SV1 /FETCH CDF INSTRUCTION DCA ARG1F /RESET IT TAD SV5 /FETCH NO OF WORDS CIA /NEGATE DCA COUNT /SET AS COUNTER CLA CLL CMA /SET -1 TAD CVTS /ADD VECTOR ADDRESS DCA IR2 /SET IN AUTO INDEX REGISTER 2 JMS I TVBTR /MOVE NUMBER TO VECTOR CLA CLL CMA /SET -1 TAD CVTS /ADD VECTOR ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD SV5 /FETCH NO OF WORDS CIA /NEGATE DCA COUNT /SET AS COUNTER JMS I TVABC /CONVERT STRING TO 36 BIT BINARY TAD SV2 /FETCH ARG2F DCA ARG1F /SET IN ARG1F TAD SV4 /FETCH ARG2 ADDRESS DCA ARG1 /SET IN ARG1 TAD CV30 /FETCH 30 DCA F2 /SET AS NO OF WORDS IAC /SET 1... DCA SFLAG /...IN FLAG JMS I TVSTOR /MOVE BINARY NUMBER TO ARG2 DCA SFLAG /CLEAR FLAG JMP I TVMST /EXIT / /THE NEXT ROUTINE CONVERTS A 36 BIT /BINARY NUMBER INTO AN ASCII STRING / CNVBWR, TAD SV3 /FETCH ARG1 DCA ARG1 /RESTORE IT TAD SV1 /FETCH ARG1F DCA ARG1F /RESTORE IT TAD CV30 /FETCH 30 DCA F2 /SET AS NO OF WORDS JMS I TVSTOR /GET ARG1 TO SR DCA SFLAG /CLEAR FLAG JMS I TVADDS /PLACE IN AC JMS I TVSWAM /SWAP TO MQ JMS I TVCBCH /CONVERT 36 BIT BINARY TO STRING TAD RCDFI /FETCH CDF INSTRUCTION DCA ARG1F /SET IT TAD SV2 /FETCH ARG2F DCA ARG2F /RESET IT TAD SV5 /FETCH COUNT CIA /NEGATE DCA COUNT /SET AS COUNTER TAD CVTSE /FETCH VECTOR ADDRESS TAD COUNT /ADD COUNTER DCA IR1 /SET IN AUTO INDEX REGISTER 1 CLA CLL CMA /SET -1 TAD SV4 /ADD ARG2 ADDRESS DCA IR2 /SET IN AUTO INDEX REGISTER 2 JMS I TVBTR /MOVE RESULT TO ARG2 JMP I TVMST /EXIT / /CONSTANTS...ROUTINES INVOLVING BINARY CONVERSIONS / CV30, 30 CVTS, TS CVTSE, TSE CM13, 0-13 CBSM63, 0-63 SV1, 0 SV2, 0 SV3, 0 SV4, 0 SV5, 0 /
/THIS ROUTINE ALLOWS EITHER A SINGLE CHARACTER /OR A NUMBER UP TO TEN DIGITS LONG TO BE KEYED /IN DEPENDING ON THE VALUE OF THE F1 AND F2 BITS / TYPICR, TAD INSTRH /FETCH RIGHT HAND 6 BITS SZA CLA /WAS IT ZERO? JMP TYPINR /NO...ENTER NUMBER JMS I TVOBTN /YES...FETCH CHARACTER DCA ACL /PLACE IN 36 BIT AC DCA ACM DCA ACH /PRNTCH, PRINT CHAR. IN ACC. RPRNCH, TAD ACL /FETCH CHARACTER JMS I TVPRNT /PRINT IT JMP I TVMST /EXIT TYPINR, TAD F1 /FETCH F1 CLL RAR /RIGHT... RTR /...JUSTIFY DCA ARG1 /SET AS ARG1 TAD F2 /FETCH F2 CLL RAR /RIGHT... RTR /...JUSTIFY DCA ARG2 /SET AS ARG2 CLA CLL CMA RTL /SET -3 TAD ARG2 /ADD ARG2 SMA SZA CLA /WAS ARG2 > 3? JMP I TVMOER /YES...TO OBJECT ERROR JMS I ICNR /NO...INPUT NUMBER DCA SFLAG1 /CLEAR FLAG JMP I TVMST /EXIT / /CONSTANTS...ENTER NUMERIC ROUTINE / ICNR, ICN / / /THIS SUBROUTINE ALLOWS THE DISK OPEN INSTRUCTION /TO CHECK THAT THE DEVICE SPECIFIED IN THE OPEN /IS FILE STRUCTURED AND TAKE APPROPRIATE ACTION / OFSTST, 0 CLA CLL TAD OPEN3 /GET DEVICE NUMBER JMS TESTFS /TEST FOR FILE STRUCTURE JMP OFST2 /ERROR RETURN CLA CLL JMP I OFSTST /RETURN OFST2, JMS GORAS /TO RASBOL AT... NFSFIA /...THIS ADDRESS JMP OPEXA /TO OPEN INST. EXIT / /RASBOL-8 MICRO PROGRAM - TAPE 12 / /THIS ROUTINE IS USED TO PERFORM THE MULTIPLY /AND DIVIDE FUNCTIONS OPERATING ON THE 36 BIT /SR AND 72 BIT AC - MQ MACRO REGISTERS / *R8ORG+2400 /DEFINE KEYBOARD INPUT BUFFER 16 WORDS INBUF, ZBLOCK 20 / CLEAR ACC AND MQ INSTRUCTION CLACR=EREXIT / MDENTR, JMS I TVSWAM /PUT AC IN MQ TAD SRH TAD SRM TAD SRL /IS SR = 0 SNA CLA /NO JMP EREXIT /YES, ERROR EXIT TAD OPCODE /NO...FETCH OPCODE CLL RAR /OBTAIN RIGHTMOST BIT SZL CLA /WAS IT ZERO? JMP MDIVR /NO...TO DIVIDE ROUTINE JMS I TVTMPY /YES...TO MULTIPLY JMS I TVSWAM /PUT ANSWER IN AC ISZ MFLAG /SET MULTIPLY FLAG JMP MLSTRT /EXIT EREXIT, JMS I TVCLAM /CLEAR AC - MQ JMP I TVMST /EXIT MDIVR, TAD MFLAG /FETCH FLAG SZA CLA /IS IT SET? JMP MDIVJ /YES...CONTINUE TAD MQH /NO...FETCH HIGH ORDER MQ SPA CLA /IS IT NEGATIVE? CLL CMA /YES...SET -1 DCA ACH /SET HIGH ORDER AC TAD ACH /FETCH HIGH ORDER AC DCA ACM /SET MED ORDER AC TAD ACH /FETCH HIGH ORDER AC DCA ACL /SET LOW ORDER AC MDIVJ, JMS I TVTDIV /DIVIDE JMS I TVSWAM /PUT ANSWER IN AC JMP I TVMST /EXIT / /
/THIS ROUTINE CARRIES OUT A LOGICAL COMPARISON BETWEEN /TWO VECTORS. IF ANY DIFFERENCE IS DISCOVERED THE 36 BIT /AC IS SET TO -1, OTHERWISE THE ROUTINE EXITS WITH AC = 0 / CMPARE, TAD ARG1F /FETCH CDF INSTRUCTION DCA CMP1 /SET IT TAD ARG2F /FETCH CDF INSTRUCTION DCA CMP2 /SET IT CMP1, 0 /SET DATA FIELD TO FETCH 1ST TAD I IR1 /FETCH 1ST WORD DCA CMP3 /STORE IT CMP2, 0 /SET DATA FIELD TO FETCH 2ND TAD I IR2 /FETCH 2ND WORD DCA CMP4 /STORE IT JMS CMPLOG /COMPARE THE TWO SZA /WERE THEY IDENTICAL? JMP CMP5 /NO...TO "UNEQUAL" EXIT ISZ COUNT /YES...INDEX COUNTER JMP CMP1 /BACK IF NOT LAST CMP5, DCA ACH /PLACE RESULT IN 36 BIT AC DCA ACM DCA ACL JMP I TVMST /EXIT / / /SUBROUTINE TO PERFORM A LOGICAL /COMPARISON BETWEEN TWO WORDS / CMPLOG, 0 TAD CMP3 /FETCH 1ST WORD SPA CLA /IS IT +VE? JMP CLGAM /NO...TEST 2ND WORD TAD CMP4 /YES...FETCH 2ND WORD SPA /IS IT +VE? JMP I CMPLOG /NO...RETURN WITH AC -VE CLGABP, CIA /YES...NEGATE IT TAD CMP3 /ADD 1ST WORD JMP I CMPLOG /EXIT WITH RESULT IN AC CLGAM, CLA CLL TAD CMP4 /FETCH 2ND WORD SPA /IS IT +VE? JMP CLGABP /NO...TO EXIT CLA CLL IAC /YES...SET 1 JMP I CMPLOG /RETURN WITH AC +VE / /CONSTANTS...LOGICAL COMPARISON ROUTINE / CMP3, 0 CMP4, 0 / / /THIS ROUTINE CONVERTS 8 BIT CHARACTERS STORED ONE /PER WORD TO 6 BIT CHARACTERS STORED TWO PER WORD / CNVW6R, TAD ARG1F /FETCH CDF INSTRUCTION DCA CNW61 /SET IT TAD ARG2F /FETCH CDF INSTRUCTION DCA CNW62 /SET IT DCA SFLAG1 /CLEAR ODD-EVEN FLAG CNW61, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH 8 BIT CHARACTER DCA ERS0 /STORE IT CNW62, 0 /SET DATA FIELD TO STORE JMS I TVPACK /PACK CHARACTER ISZ COUNT /INDEX COUNTER JMP CNW61 /BACK IF NOT LAST DCA SFLAG1 /CLEAR FLAG JMP I TVRAXT /EXIT - RESTORE ACC. / /
/GET AND PUT RECORD, POSN IN ACL, LENGTH IN ACM GETR, TAD ARG1 DCA ARG2 /MOVE 2ND ARG TAD ACL TAD (FILBLK /1ST ARG DCA ARG1 GETR2, TAD ACM JMP MOVTR PUTR, TAD ACL TAD (FILBLK DCA ARG2 JMP GETR2 /THIS ROUTINE READS OR WRITES A GIVEN BLOCK IN ABSOLUTE MODE / ABSRWR, CLA CLL TAD ACM /FETCH DEVICE NUMBER DCA CTDEV /SET IT TAD ACL /FETCH BLOCK NUMBER DCA CTBLK /SET IT TAD OPCODE /FETCH OPCODE SNA CLA /WAS OPCODE = 0? CLA CLL CML RAR /YES...SET AC0 TO 1 JMS I TVBLKO /OPERATE ON BLOCK JMP I TVMST /EXIT / / /RASBOL-8 MICRO PROGRAM - TAPE 13 / /THIS ROUTINE COMBINES THE 36 BIT NUMBER IN THE /MACRO AC WITH A SPECIFIED MASK TO PRODUCE A /FORMATTED PRINT IMAGE IN A SPECIFIED LOCATION / *R8ORG+2600 /POWER RESTART PFRSEN, CLA CLL /CLEAR AC AND LINK KCC /INITIALISE KEYBOARD FLAG TLS / " PRINTER " PFL2, TAD PFACSV /RESTORE AC JMP I PFAIL /RESUME INTERRUPTED PROGRAM / IMPRUR, TAD ARG1F /FETCH CDF INSTRUCTION DCA IPSV1 /SAVE IT TAD ARG2F /FETCH CDF INSTRUCTION DCA IPSV2 /SAVE IT TAD ARG1 /FETCH ARG1 DCA IPSV3 /SAVE IT TAD ARG2 /FETCH ARG2 DCA IPSV4 /SAVE IT TAD COUNT /FETCH LENGTH DCA IPSV5 /SAVE IT JMS I TVCBSV /CLEAR STORAGE VECTORS TAD ACH /FETCH HIGH ORDER AC SMA CLA /IS NO -VE? JMP PICON /NO...CONTINUE IAC /YES...SET... DCA SFLAG1 /...1 IN FLAG JMS I TVCOMP /COMPLEMENT AC ACH PICON, JMS I TVSWAM /PUT AC IN MQ JMS I TVCBCH /CONVERT NO TO CHARACTERS TAD IPSV1 /FETCH CDF INSTRUCTION DCA IP1 /SET IT TAD RCDFI /FETCH CDF INSTRUCTION DCA IP2 /SET IT CLA CLL CMA /SET -1 TAD IPSV3 /ADD ARG1 ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 CLA CLL CMA /SET -1 TAD IPTS1 /ADD VECTOR ADDRESS DCA IR2 /SET IN AUTO INDEX REGISTER 2 TAD IPM5 /FETCH -5 DCA COUNT /SET AS COUNTER IP1, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH 2 PACKED CHARACTERS DCA ERS0 /STORE THEM JMS I TVSBUP /UNPACK THEM IP2, 0 /SET DATA FIELD TO STORE TAD ERS1 /FETCH 6 BIT CHARACTER DCA ERS0 /STORE IT JMS I TVSBTA /CONVERT TO 8 BIT CODE TAD ERS0 /FETCH 8 BIT CHARACTER DCA I IR2 /STORE IT TAD ERS2 /FETCH 6 BIT CHARACTER DCA ERS0 /STORE IT JMS I TVSBTA /CONVERT TO 8 BIT CODE TAD ERS0 /FETCH 8 BIT CHARACTER DCA I IR2 /STORE IT ISZ COUNT /INDEX COUNTER JMP IP1 /BACK IF NOT LAST JMS I PFPIS /TO CREATE IMAGE TAD RCDFI /FETCH CDF INSTRUCTION DCA ARG1F /SET IT TAD OPCODE /FETCH OPCODE TAD IPM70 /SUBTRACT 70 SZA CLA /WAS OPCODE 70? JMP PRNTUR /NO...TO PRINT ROUTINE TAD IPSV5 /YES...FETCH LENGTH JMS SETVEC /TO SET VECTOR ARGUMENTS TAD IPSV2 /FETCH CDF INSTRUCTION DCA ARG2F /SET IT TAD IPSV4 /FETCH ARG2 ADDRESS DCA ARG2 /RESTORE IT JMP CNVW6R /STORE PACKED IMAGE IN ARG2 / /THIS ROUTINE PRINTS OUT THE IMAGE JUST PREPARED / PRNTUR, TAD IPSV4 /FETCH LENGTH JMS SETVEC /TO SET VECTOR ARGUMENTS PRNTU1, CDF 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH CHARACTER JMS I TVPRNT /PRINT IT ISZ COUNT /INDEX COUNTER JMP PRNTU1 /BACK IF NOT FINISHED JMP I TVRAXT /TO EXIT / /CONSTANTS..."IMAGE" AND "PRINTU" ROUTINES / IPTS1, TS1 IPTS2E, TS2E PFPIS, PFPI IPM5, 0-5 IPM70, 0-70 IPSV1, 0 IPSV2, 0 IPSV3, 0 IPSV4, 0 IPSV5, 0 / / /THIS ROUTINE PRINTS A SPECIFIED /CHARACTER A GIVEN NUMBER OF TIMES / PRNTCR, TAD INSTRH /FETCH NUMBER SNA TAD ACL /COUNT IN ACC. SNA JMP I TVMST /NIL PRINT CIA /NEGATE IT DCA COUNT /SET AS COUNTER PRCLP, TAD ARG1 /FETCH CHARACTER JMS I TVPRNT /PRINT IT ISZ COUNT /INDEX COUNTER JMP PRCLP /BACK IF NOT LAST JMP I TVMST /EXIT / / /THIS SUBROUTINE HALTS THE MACHINE /IF A POWER FAILURE HAS OCCURRED / PFAIL, 0 DCA PFACSV SPL /HAS POWER FAILED? JMP TIMESH TAD PFRSI /FETCH "JMP" INSTRUCTION DCA /SET IT TAD PFRSA /FETCH ADDRESS DCA 1 /SET IT HLT /HALT JMP PFRSEN /CONSTANTS...POWER FAIL ROUTINE / PFRSI, JMP I 1 PFRSA, PFRSEN PFACSV, 0 / / /THIS ROUTINE, WRITTEN IN RASBOL, PRINTS AN /ERROR MESSAGE FOR THE DISK CLOSE INSTRUCTION / CLERMS, PRINT 16 ;TEXT '_FILE NOT OPEN' GOTO ;RFRAS / /RASBOL-8 MICRO PROGRAM - TAPE 14 / /TRIPLE PRECISION INPUT ROUTINE / *R8ORG+3000 ICN, 0 ICST, JMS I TVCLAM /CLEAR 36 BIT AC / /NOW INITIALISE THE INPUT LOOP / DCA DPCT /CLEAR NO OF PLACES COUNTER DCA SFLAG1 /CLEAR SIGN FLAG DCA IPF /CLEAR POINT FLAG CMA /SET -1 IN ACCUMULATOR TAD ITS /ADD ADDRESS OF BUFFER DCA IR1 /PLACE IN AUTO INDEX REGISTER 1 TAD IM11 /FETCH -11 DCA ICT /SET AS INPUT COUNT INDEX / /THE INPUT LOOP BEGINS HERE / INCH, JMS I TVOBTN /FETCH CHARACTER FROM KEYBOARD DCA ERS0 /STORE TEMPORARILY / /NOW TEST THAT INPUT CHARACTER WAS NUMERIC / JMS I TVCMPA /COMPARE ERS0 /CHARACTER WITH
260 /ASCII ZERO SMA CLA /WAS IT NON NUMERIC? JMP NT /NO...CONTINUE JMP CHAR /YES...TEST IF LEGAL NT, JMS I TVCMPA /COMPARE ERS0 /CHARACTER WITH 271 /ASCII 9 SMA SZA CLA /WAS CHARACTER NUMERIC? JMP ERROR /NO...ERROR TAD IPF /YES...FETCH POINT FLAG SZA CLA /POINT TYPED? ISZ DPCT /YES...COUNT PLACE TAD ERS0 /NO...FETCH CHARACTER DCA I IR1 /STORE IN BUFFER ISZ ICT /INDEX INPUT COUNT JMP INCH /BACK IF NOT LAST JMP IEND /END OF INPUT / /IF CHARACTER WAS NOT NUMERIC, /TEST THAT IT WAS ALLOWABLE / CHAR, JMS I TVCMPA /COMPARE ERS0 /CHARACTER WITH 256 /ASCII DECIMAL POINT SNA CLA /WAS IT A DECIMAL POINT? JMP IPNT /YES...CHECK DECIMAL JMS I TVCMPA /NO...CONTINUE TESTING ERS0 /COMPARE CHARACTER 255 /WITH ASCII MINUS SIGN SNA CLA /WAS IT A MINUS SIGN? JMP IMS /YES...CHECK NEGATIVE JMS I TVCMPA /NO...CONTINUE TESTING ERS0 /COMPARE CHARACTER 215 /WITH ASCII RETURN SNA CLA /WAS IT A CARRIAGE RETURN? JMP IEND /YES...END OF INPUT JMP ERROR /NO...CHARACTER ILLEGAL...ERROR / /TEST THAT DECIMAL POINT IS ALLOWED / IPNT, TAD ARG1 /FETCH NO OF PLACES ALLOWED SNA CLA /WAS IT ZERO? JMP ERROR /YES...ERROR ISZ IPF /NO...SET POINT FLAG JMP INCH /BACK FOR NEXT CHARACTER / /TEST THAT NEGATIVE NUMBER IS ALLOWED / IMS, JMS I TVCMPA /COMPARE ARG2 /NO OF WORDS IN FIELD 3 /WITH 3 SZA CLA /WAS IT 3? JMP ERROR /NO...ERROR ISZ SFLAG1 /YES...SET SIGN FLAG JMP INCH /BACK FOR NEXT CHARACTER / /NOW THAT THE COMPLETE NUMBER HAS BEEN /INPUT, IT MUST BE CONVERTED TO BINARY /AND THEN STORED IN THE SPECIFIED FIELD / IEND, TAD IPF /FETCH POINT FLAG SNA CLA /DECIMAL POINT ENTERED? JMP TBIN /NO...CONVERT AND STORE NPT, TAD ARG1 /YES...FETCH NO OF PLACES CIA /MAKE NEGATIVE TAD DPCT /ADD NO OF PLACES ENTERED SMA SZA /WAS IT > ALLOWED? JMP ERROR /YES...ERROR SMA CLA /NO...WAS IT < ALLOWED? JMP TBIN /NO...CONVERT AND STORE TAD INA0 /YES...FETCH ASCII ZERO / /NUMBER IS PADDED WITH ZEROS IF NECESSARY / DCA I IR1 /STORE ZERO IN BUFFER ISZ DPCT /INDEX PLACE COUNT ISZ ICT /INDEX NO OF "ENTRIES" JMP NPT /BACK IF NOT LAST PLACE / /NUMBER IS NOW CONVERTED TO BINARY / TBIN, TAD IM11 /FETCH -11 CIA /NEGATE TAD ICT /CALCULATE NO OF FIGURES ENTERED SNA /WAS IT 0? JMP NONUM /YES...TO EXIT CIA /NO...NEGATE DCA COUNT /SET AS COUNTER CLA CLL CMA /SET -1 TAD ITS /ADD VECTOR ADDRESS DCA IR5 /SET IN AUTO INDEX REGISTER 5 JMS I TVABC /CONVERT TO BINARY CLA CLL CMA RAL /NO...SET -2 IN ACCUMULATOR TAD ARG2 /ADD NO OF WORDS IN FIELD SMA SZA /WAS IT = 3? JMP CHSG /YES...STORE NUMBER
SMA CLA /NO...WAS IT = 2? JMP ITO /YES...TEST HIGH ORDER TAD ACM /NO...FETCH MED ORDER AC ITO, TAD ACH /FETCH HIGH ORDER AC SZA CLA /OVERFLOW? JMP ERROR /YES...ERROR CHSG, CLA CLL /CLEAR AC AND LINK TAD SFLAG1 /FETCH FLAG SNA CLA /WAS IT ZERO? JMP I ICN /YES...RETURN...36 BIT AC +VE JMS I TVCOMP /NO...COMPLEMENT AC ACH JMP I ICN /RETURN...36 BIT AC -VE / /NUMERIC INPUT ROUTINE...ERROR EXIT / ERROR, CLA CLL TAD IBELL /FETCH BELL CHARACTER JMS I TVPRNT /PRINT IT JMP ICST /BACK TO ENTER NUMBER AGAIN / /NUMERIC INPUT ROUTINE...NO INPUT EXIT / NONUM, JMS I TVCLAM /CLEAR AC-MQ JMP I ICN /RETURN / /CONSTANTS...NUMERIC INPUT ROUTINE / ITS, TS IM11, 0-13 INA0, 260 IBELL, 207 ICT, 0 DPCT, 0 IPF, 0 / / /SUBROUTINE TO PERFORM AN ARITHMETIC /COMPARISON BETWEEN TWO CHARACTERS / /THE ROUTINE SUBTRACTS THE SECOND CHARACTER /FROM THE FIRST AND LEAVES THE RESULT IN THE /ACCUMULATOR TO BE TESTED BY THE MAIN PROGRAM / CMPA, 0 CLA CLL TAD I CMPA /FETCH CHARACTER ADDRESS DCA CATS /STORE IT ISZ CMPA /INDEX FOR SECOND CHARACTER TAD I CMPA /FETCH SECOND CHARACTER CIA /NEGATE TAD I CATS /ADD FIRST CHARACTER ISZ CMPA /INDEX FOR RETURN JMP I CMPA /RETURN / /CONSTANTS...COMPARISON ROUTINE / CATS, 0 /
/RASBOL-8 MICRO PROGRAM - TAPE 15 / /SUBROUTINE TO PREPARE A FORMATTED PRINT IMAGE / *R8ORG+3200 PFPI, 0 CLA CLL TAD T0 /FETCH NUMBER VECTOR ADDRESS DCA ERS0 /SET IN NUMBER COUNTER TAD T1 /FETCH MASK VECTOR ADDRESS DCA ERS1 /SET IN MASK COUNTER TAD T2 /FETCH RESULT VECTOR ADDRESS DCA ERS2 /SET IN RESULT COUNTER / /FIRST TEST SIGN / TAD SFLAG1 /FETCH SIGN FLAG SNA CLA /IS NUMBER +VE? JMP PUCS /YES...UPDATE COUNTERS DCA SFLAG1 /NO...CLEAR FLAG PMRL, TAD I ERS1 /MOVE MASK CHARACTER... DCA I ERS2 /...TO RESULT VECTOR PUCS, JMS I TVPDPR /UPDATE MASK COUNTER ERS1 JMS I TVPDPR /UPDATE RESULT COUNTER ERS2 / /THE MAIN LOOP OF THE ROUTINE MERGES MASK CHARACTERS /WITH NUMERICS AND STORES THEM IN THE RESULT VECTOR / PILP, CLA CLL TAD I ERS1 /FETCH MASK CHARACTER DCA PCHA /STORE IT JMS I TVCMPA /COMPARE MASK... PCHA /...CHARACTER... PBLANK, 240 /...WITH BLANK SNA CLA /WAS IT A BLANK? JMP PBLK /YES...PROCESS BLANK JMS I TVCMPA /NO...COMPARE... PCHA /...MASK CHARACTER... 334 /...WITH BACKSLASH SNA CLA /WAS IT A BACKSLASH? JMP PBSL /YES...PROCESS BACKSLASH JMS I TVCMPA /NO...COMPARE... PCHA /...MASK CHARACTER... 260 /...WITH ZERO SNA CLA /WAS IT A ZERO? JMP PZER /YES...PROCESS ZERO JMS I TVCMPA /NO...COMPARE... PCHA /...MASK CHARACTER... 252 /...WITH ASTERISK
SNA CLA /WAS IT AN ASTERISK? JMP PAST /YES...PROCESS ASTERISK JMS I TVCMPA /NO...COMPARE... PCHA /...MASK CHARACTER... 244 /...WITH DOLLAR SIGN SNA CLA /WAS IT A DOLLAR SIGN? JMP PDOL /YES...PROCESS DOLLAR SIGN JMP PMRL /NO...MOVE MASK CHARACTER / /IF MASK CHARACTER IS A BACKSLASH, TRUNCATE NUMBER BY /UPDATING COUNTERS WITHOUT SHIFTING ANY CHARACTERS / PBSL, TAD PBLANK /FETCH ASCII BLANK DCA I ERS0 /SET IN NUMBER JMS I TVPDPR /UPDATE NUMBER COUNTER ERS0 JMS I TVPDPR /UPDATE MASK COUNTER ERS1 JMP PILP /BACK FOR NEXT CHARACTER / /THIS ROUTINE DIRECTS THE PRINT IMAGE PREPARATION /SUBROUTINE TO THE APPROPRIATE MERGING ROUTINE /IF THE MASK CHARACTER IS A BLANK / PBLK, JMS PTES /TEST NUMBER CHARACTER PSNR PFIN / /SIMILARLY, IF THE MASK CHARACTER IS A ZERO / PZER, JMS PTES /TEST NUMBER CHARACTER PSNR PMRL / /IF THE MASK CHARACTER IS AN ASTERISK / PAST, JMS PTES /TEST NUMBER CHARACTER PNRF PRFL / /IF THE MASK CHARACTER WAS A DOLLAR SIGN / PDOL, JMS PTES /TEST NUMBER CHARACTER PNRF PFIN / /THIS ROUTINE SHIFTS A NUMBER CHARACTER /TO THE RESULT VECTOR AND UPDATES ALL 3 /COUNTERS. IT THEN RETURNS TO EITHER THE /MAIN LOOP OR THE PRINT IMAGE SUBROUTINE EXIT / PSNR, TAD I ERS0 /FETCH NUMBER CHARACTER DCA I ERS2 /STORE IN RESULT VECTOR ISZ SFLAG /SET FLAG JMS PPUCHK /UPDATE 3 COUNTERS AND SET EXIT
JMP PILP /BACK TO MAIN LOOP / /THIS ROUTINE SHIFTS A NUMBER CHARACTER TO THE RESULT /VECTOR AND UPDATES THE NUMBER AND RESULT COUNTERS. IT /THEN RETURNS TO TEST ANOTHER NUMBER CHARACTER / PNRF, TAD I ERS0 /FETCH NUMBER CHARACTER DCA I ERS2 /STORE IN RESULT VECTOR DCA SFLAG /CLEAR FLAG JMS PPUCHK /UPDATE 2 COUNTERS AND SET EXIT CLA CLL CMA RAL /SET -2 TAD PTES /ADD ADDRESS FROM SUBROUTINE DCA PTES /RESET IT JMP I PTES /BACK FOR NEXT NUMBER CHARACTER / /THIS ROUTINE SHIFTS A MASK CHARACTER TO THE RESULT /VECTOR AND UPDATES THE NUMBER AND RESULT COUNTERS. /IT THEN RETURNS EITHER TO TEST ANOTHER NUMBER /CHARACTER OR TO THE PRINT IMAGE SUBROUTINE EXIT POINT / PRFL, TAD I ERS1 /FETCH MASK CHARACTER DCA I ERS2 /STORE IN RESULT VECTOR DCA SFLAG /CLEAR FLAG JMS PPUCHK /UPDATE 2 COUNTERS AND SET EXIT JMP PAST /TO TEST NEXT NUMBER CHARACTER / /THIS IS THE PRINT IMAGE SUBROUTINE EXIT POINT / PFIN, TAD I ERS1 /FETCH MASK CHARACTER DCA I ERS2 /STORE IN RESULT VECTOR DCA SFLAG /CLEAR FLAG JMP I PFPI /RETURN / /CONSTANTS...PRINT IMAGE PREPARATION SUBROUTINE / T0, TSE T1, TS1E T2, TS2E PCHA, 0 / / /SUBROUTINE TO TEST NUMBER CHARACTER FOR A /BLANK AND EXIT TO THE APPROPRIATE ROUTINE / PTES, 0 CLA CLL TAD I PTES /FETCH "NO" ADDRESS DCA PTNO /STORE IT ISZ PTES /INDEX FOR "YES" ADDRESS TAD I PTES /FETCH "YES" ADDRESS DCA PTYE /STORE IT TAD I ERS0 /FETCH NUMBER CHARACTER TAD PM240 /SUBTRACT ASCII BLANK SZA CLA /WAS IT A BLANK? JMP I PTNO /NO...TO "NO" ROUTINE JMP I PTYE /YES...TO "YES" ROUTINE / /CONSTANTS...NUMBER CHARACTER TEST ROUTINE / PM240, 0-240 PTNO, 0 PTYE, 0 / / /SUBROUTINE TO UPDATE COUNTERS AND SET THE /EXIT FOR THREE OF THE PROCESSING ROUTINES / PPUCHK, 0 CLA CLL TAD SFLAG /FETCH FLAG SNA CLA /WAS IT ZERO? JMP P2PU /YES...UPDATE 2 COUNTERS JMS I TVPDPR /NO...UPDATE MASK COUNTER ERS1 P2PU, TAD PBLANK /FETCH ASCII BLANK DCA I ERS0 /SET IN NUMBER JMS I TVPDPR /UPDATE NUMBER COUNTER ERS0 JMS I TVPDPR /UPDATE RESULT COUNTER ERS2 TAD ERS0 /FETCH NUMBER COUNTER TAD PMTS /SUBTRACT STOP ADDRESS SMA CLA /FINISHED? JMP I PPUCHK /NO...BACK TO CONTINUE JMP PFIN /YES...EXIT / /CONSTANTS...EXIT SETUP ROUTINE / PMTS, 0-TS
/ /RASBOL-8 MICRO PROGRAM - TAPE 16 / /SUBROUTINE TO CONVERT STRINGS OF STORED 8 BIT /ASCII CHARACTERS INTO A 36 BIT BINARY NUMBER / *R8ORG+3400 ABC, 0 CLA CLL TAD COUNT DCA ABCKNT TAD CV10 /FETCH 10 DCA SRL /SET SR... DCA SRM /...EQUAL... DCA SRH /...TO 10 CDF /SET DATA FIELD TO ZERO CNLP, JMS I TVSWAM /MOVE AC TO MQ DCA ACH /ZERO 36 BIT AC DCA ACM DCA ACL JMS I TVTMPY /MULTIPLY AC-MQ BY 10 JMS I TVSWAM /MOVE RESULT TO AC DCA MQH /ZERO 36 BIT MQ DCA MQM DCA MQL TAD I IR5 /FETCH CHARACTER AND CNMSK /MASK OFF ASCII CODE DCA SR1L /PLACE RESULTING NO IN SR1 DCA SR1M DCA SR1H CLA CLL IAC /SET 1... DCA SFLAG /...IN FLAG JMS I TVADDS /ADD SR1 TO AC DCA SFLAG /CLEAR FLAG ISZ ABCKNT /INDEX COUNTER JMP CNLP /BACK IF NOT LAST JMP I ABC /RETURN / /CONSTANTS...ASCII TO BINARY SUBROUTINE / CV10, 12 CNMSK, 0017 ABCKNT, 0 / / /SUBROUTINE TO PACK TWO 6 BIT CHARACTERS /INTO ONE SPECIFIED LOCATION IN CORE / PACK, 0 CLA CLL /CLEAR WORK AREAS TAD ERS0 /FETCH CHARACTER AND MASK /STRIP TO 6 BIT FORM DCA PSC /STORE TEMPORARILY TAD SFLAG1 /FETCH ODD-EVEN FLAG CLL RAR /GET RIGHTMOST BIT SZL CLA /WAS IT EVEN? JMP P2ND /NO...PACK RIGHT HAND CHARACTER TAD PSC /YES...FETCH CHARACTER BSW /LEFT JUSTIFY IT DCA I ARG2 /PACK IT AS LEFT HAND CHARACTER PACK2, ISZ SFLAG1 /FLAG +1 JMP I PACK /RETURN P2ND, TAD I ARG2 /FETCH PACKING LOCATION TAD PSC /ADD NEW CHARACTER DCA I ARG2 /STORE RESULT ISZ ARG2 /INDEX FOR NEXT LOCATION JMP PACK2 /RETURN / /CONSTANTS...PACK CHARACTERS ROUTINE / MASK, 0077 PSC, 0 / / /THIS ROUTINE ALLOWS STRINGS OF EITHER /8 BIT OR 6 BIT CHARACTERS TO BE ENTERED / TYPER, TAD ARG2 /FETCH NO OF CHARACTERS CIA /NEGATE DCA COUNT /SET AS COUNTER DCA SFLAG /CLEAR FLAG DCA SFLAG1 /CLEAR ODD-EVEN FLAG TAD ARG1F /FETCH CDF INSTRUCTION DCA TYP1 /SET IT TAD ARG1 /FETCH ARG1 ADDRESS DCA ARG2 /SET IN ARG2 CLA CLL CMA /SET -1 TAD ARG1 /ADD ARG1 ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TYPLP, CDF /SET DATA FIELD TO TEST FLAG TAD SFLAG /FETCH FLAG SZA CLA JMP TYPE /IS IT SET? JMS I TVOBTN /NO...FETCH CHARACTER DCA ERS0 /STORE IT JMS I TVCMPA /COMPARE... ERS0 /...CHARACTER...
215 /...WITH RETURN SZA CLA /WAS IT RETURN? JMP TYPRC /NO...CONTINUE TYPE, TAD FILCHA /FILL CHARACTER DCA ERS0 /YES...CLEAR WORK AREA ISZ SFLAG /SET FLAG TYPRC, TAD ERS0 /...FETCH CHARACTER JMS I TVPRNT /PRINT IT TYP1, 0 /SET DATA FIELD TO STORE TAD OPCODE /FETCH OPCODE CLL RAR /OBTAIN RIGHTMOST BIT SZL /WAS IT ZERO? JMP TYPWDR /NO...TO 8 BIT ROUTINE TYPTXR, CLA CLL /YES...6 BIT ROUTINE JMS I TVPACK /PACK CHARACTER JMP TYPEND /TO CONTINUE TYPWDR, CLA CLL TAD ERS0 /FETCH CHARACTER DCA I IR1 /STORE IT TYPEND, ISZ COUNT /INDEX COUNTER JMP TYPLP /BACK IF NOT LAST DCA SFLAG1 /CLEAR FLAGS DCA SFLAG JMP I TVMST /EXIT FILCHA, 0 /SET TRAILING SPACES OR NULLS FILLBL, TAD (240 FILLZO, DCA FILCHA JMP I TVMST / / /THIS ROUTINE CONVERTS A 1 OR 2 WORD NUMBER TO /A 3 WORD SIGNED NUMBER DEPENDING ON THE VALUE /OF THE LEFTMOST BIT OF THE UNSIGNED NUMBER / SIGNR, TAD F2 /FETCH F2 CLL RAR /RIGHT... RTR /...JUSTIFY CIA /NEGATE TAD (2 /ADD 2 SPA /WAS F2 > 2? JMP RRTRR /SHIFT INSTR. SNA /NO...WAS F2 = 1? JMP SGN2R /NO...PROCESS 24 BIT NUMBER SGN2, CLA CLL CML RAR /YES...SET 4000 AND ACL /MASK 12 BIT NUMBER SZA /WAS IT NEGATIVE? CLA CLL CMA /YES...SET -VE WORD DCA ACM /SET MED ORDER AC SGN2R, CLA CLL CML RAR /SET 4000 AND ACM /MASK 24 BIT NUMBER SZA /WAS IT NEGATIVE? CLA CLL CMA /YES...SET -VE WORD DCA ACH /SET HIGH ORDER AC JMP I TVMBNT /EXIT / /RASBOL-8 MICRO PROGRAM - TAPE 17 / /THIS ROUTINE IS USED IF THE MICRO PROGRAM DETECTS /AN ERROR IN THE MACRO INSTRUCTION IT IS EXECUTING. /THE ROUTINE PRINTS A MESSAGE AND THE OPERATOR MAY /THEN DECIDE TO CONTINUE PROGRAM EXECUTION OR TO /ABORT THE PROGRAM AND RETURN TO THE OS/8 MONITOR. / *R8ORG+3600 MOBERR, CLA CLL / /FIRST, PRINT MESSAGE / JMS GORAS /TO RASBOL AT... OBMES1 /...THIS ADDRESS / /NOW PRINT THE 5 DIGIT ADDRESS AT WHICH THE /INCORRECT MACRO INSTRUCTION IS TO BE FOUND / TAD CRIF /FETCH FIELD CLL RAR /RIGHT... RTR /...JUSTIFY TAD (260 /ADD ASCII 0 JMS I TVPRNT /PRINT FIELD TAD CRIA /FETCH ADDRESS JMS PROCT /TO PRINT 4 OCTAL DIGITS JMP EXITR / /THESE RASBOL INSTRUCTIONS SIMPLIFY THE /OBJECT ERROR ROUTINE AND MAKE IT SHORTER / OBMES1, PRINT 22 ;TEXT '__OBJECT ERROR AT ' RFRAS, CLEAR GOPAL ;RETRAS /
/ / /THIS SUBROUTINE PRINTS A 12 BIT /NUMBER AS A 4 DIGIT OCTAL NUMBER / PROCT, 0 DCA ERS0 /STORE NUMBER DCA ERS1 /CLEAR TEMPORARY LOCATION TAD (-4 /SET -4 AS... DCA COUNT /...DIGIT COUNTER DIGUNP, TAD ERS0 /FETCH NUMBER - LINK BIT CLL RAL /ROTATE 1 LEFT TAD ERS1 /ADD STORED WORD RAL /ROTATE 3 LEFT RTL DCA ERS1 /STORE ROTATED NUMBER RAR /GET LINK BIT DCA ERS0 /STORE IT TAD ERS1 /FETCH ROTATED NUMBER AND (7 /MASK OFF 9 BITS TAD (260 /ADD ASCII 0 JMS I TVPRNT /PRINT DIGIT CLA CLL ISZ COUNT /COUNT + 1 JMP DIGUNP /BACK IF NOT LAST JMP I PROCT /RETURN / / /SUBROUTINE TO SET UP ARGUMENTS AND CALL BTR / BTRSET, 0 CLA CLL TAD I BTRSET /FETCH "FROM" ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 ISZ BTRSET /INDEX FOR NEXT ARGUMENT TAD I BTRSET /FETCH "TO" ADDRESS DCA IR2 /SET IN AUTO INDEX REGISTER 2 ISZ BTRSET /INDEX FOR NEXT ARGUMENT TAD I BTRSET /FETCH LENGTH (-VE) DCA COUNT /SET AS COUNTER JMS I TVBTR /MOVE WORDS ISZ BTRSET /INDEX FOR RETURN JMP I BTRSET /RETURN /RANGE INSTR. CHECK THAT ACL IS BETWEEN ARG2 AND COUNT RANGER, TAD ACH TAD ACM SZA CLA JMP GOTOR TAD ACL CIA TAD ARG2 SMA SZA CLA JMP GOTOR TAD COUNT CIA TAD ACL SPA SNA CLA JMP I TVMST JMP GOTOR / / / / /THIS ROUTINE DETERMINES IF A DEVICE IS FILE STRUCTURED OR /NOT. THE ROUTINE IS ENTERED WITH THE NUMBER ALLOCATED TO /THE DEVICE BY THE SYSTEM IN THE AC. IF THE DEVICE IS NOT FILE /STRUCTURED THE ROUTINE TAKES THE ERROR RETURN TO THE INSTRUCTION /FOLLOWING THE CALL. IF THE DEVICE IS FILE STRUCTURED THE /ROUTINE RETURNS TO THE INSTRUCTION TWO WORDS AFTER THE CALL. / TESTFS, 0 TAD (7757 /ADD TABLE ADDRESS - 1 DCA TESTPT /SET AS POINTER CDF 10 /SET DATA FIELD TO 1 TAD I TESTPT /GET DEVICE CONTROL WORD CDF 0 /RESET FIELD TO 0 SPA CLA /FILE STRUCTURED? ISZ TESTFS /YES...NORMAL EXIT JMP I TESTFS /RETURN / /CONSTANT / TESTPT, 0 / / /THIS ROUTINE, WRITTEN IN RASBOL, SETS UP A /FILE INFORMATION AREA FOR A NON FILE STRUCTURED /DEVICE DURING THE EXECUTION OF AN OPEN INSTRUCTION / NFSFIA, LOADX2 ;OPFPA MOVE1 ;OPEN3 ;0 LOADX2 ;OPFPA CLRWDS ;10 ;1 GOTO ;RFRAS /
/PRINT A CHARACTER PRNCH, 0 CDF 0 WPF, JMS I TVFAIL TSF JMP WPF TLS WPF2, CLA CLL TAD NONPR SNA CLA JMP I PRNCH JMS I TVFAIL /WAIT FOR KB JMP WPF2 / / /RASBOL-8 MICRO PROGRAM - TAPE 19 / /THIS TAPE IS THE START OF THE RASBOL /DISK INSTRUCTIONS EXECUTION ROUTINES / /BEGIN BY DEFINING SOME DISK ROUTINES WORK AREAS / *R8ORG+4000 CFPA, 0 /CURRENT FILE POINTER ADDRESS CFP1, 0 /DEVICE NUMBER FOR CURRENT RECORD CFP2, 0 /BLOCK ADDRESS OF CURRENT FILE CFRBA, 0 /BLOCK ADDRESS OF CURRENT RECORD CFRWI, 0 /WORD INDEX OF CURRENT RECORD TNRP1, ZBLOCK 2 /TOTAL NUMBER OF RECORDS IN FILE (+1) LSDEV, 0 /LAST DEVICE USED / /DEFINE CURRENT FILE INFORMATION BLOCK / IIDATE, 0 /FILE ALTERATION DATE IINBI, 0 /NUMBER OF BLOCKS IN INDEX IIFUBN, 0 /FIRST UNUSED AREA - BLOCK NUMBER IIFUWN, 0 /FIRST UNUSED AREA - WORD NUMBER IIRECL, 0 /LENGTH OF RECORD - WORDS IIKEYL, 0 /LENGTH OF KEY - WORDS IINBFM, 0 /NUMBER OF BLOCKS IN FILE (-VE) / / /THIS ROUTINE ACTUALLY READS FROM AND WRITES TO THE DEVICE /USING THE DEVICE HANDLER LOADED BY THE "OPEN" ROUTINE / BLOKOP, 0 TAD (200 /ADD 200 DCA BOFCW /SET AS FUNCTION CONTROL WORD TAD CTBLK /FETCH BLOCK NUMBER DCA BOBN /SET IT TAD CTBLK DCA CFRBA TAD CTDEV /FETCH DEVICE NUMBER DCA LSDEV TAD CTDEV TAD (7646 /ADD TABLE ADDRESS - 1 DCA DHENTP /STORE AS POINTER CDF 10 /SET DATA FIELD TO 1 TAD I DHENTP /FETCH HANDLER ENTRY POINT DCA DHENTP /STORE IT CDI 0 /SET FIELDS TO 0 JMS I DHENTP /TO DEVICE HANDLER BOFCW, 0 /FUNCTION CONTROL WORD FILBLK /BUFFER ADDRESS BOBN, 0 /STARTING BLOCK NUMBER SKP /ERROR RETURN JMP I BLOKOP /TRANSFER COMPLETE...RETURN BOBN3, CLA CLL CMA RAL /SET -2 IN 36 BIT AC DCA ACL JMP SGN2 /TO EXIT / /CONSTANTS...DISK READ/WRITE ROUTINE / DHENTP, 0 / /
/THIS ROUTINE CONTROLS THE OPERATIONS OF READING /FROM THE DEVICE IN RANDOM OR SEQUENTIAL MODE / DREADR, TAD RCDFI /SET CDF INSTRUCTIONS DCA ARG1F TAD RCDFI DCA ARG2F DCA DRTSL1 /CLEAR COMMON WORK LOCATIONS DCA DRTSL2 DCA DRTSL3 DCA DRTSL4 CDF 0 /SET DATA FIELD TO 0 TAD ARG1 /FETCH FILE POINTER ADDRESS DCA DGSFSX /STORE IT / /NOW THAT THE ROUTINE HAS BEEN INITIALISED, THE /TYPE OF READ TO BE EXECUTED MUST BE DETERMINED / TAD ARG1 /FETCH FILE POINTER ADDRESS DCA CFPA /SAVE IT TAD F2 /FETCH F2 BITS CLL RAR /RIGHT... RTR /...JUSTIFY CIA /NEGATE SZA /WAS F2 = 0? SKP /NO...CONTINUE JMP RDRANR /YES...TO RANDOM IAC /ADD 1 SZA CLA /WAS F2 = 1? JMP I TVMOER /NO...TO OBJECT ERROR JMP RDSEQR /YES...TO SEQUENTIAL / /THIS ROUTINE READS A GIVEN RECORD IN RANDOM /MODE. THE REQUIRED KEY IS IN THE 36 BIT AC / RDRANR, JMS GORAS /EXIT TO RASBOL... DGSFS /...AT THIS ADDRESS / /WHEN THE REQUIRED RECORD HAS BEEN FOUND, THE /RASBOL-8 SECTION OF THE ROUTINE RETURNS TO HERE, /WHERE THE RECORD POSITION COUNT, INDICATING WHERE /THE REQUIRED RECORD IS TO BE FOUND, IS LOADED /INTO THE 36 BIT AC. THE INTERPRETER THEN CARRIES /ON TO THE NEXT MACRO INSTRUCTION OF THE PROGRAM / DRDREX, TAD DGRPK /FETCH RECORD POSITION COUNT DCA ACL /SET IN 36 BIT AC TAD IIRECL /REC.LENGTH DCA ACM DCA ACH JMP I TVMBNT /EXIT / /CONSTANTS...READ RANDOM ROUTINE / REQKEY, ZBLOCK 3 DGDBK=DRTSL2 DGRPK=DRTSL3 DREADF=DRTSL1 / / /THIS ROUTINE READS A GIVEN RECORD IN SEQUENTIAL MODE. /THE NUMBER OF THE REQUIRED RECORD IS IN THE 36 BIT AC / RDSEQR, CLA CLL TAD DGSFSX /FETCH FILE POINTER ADDRESS DCA DSQSFX /SET IT JMS GORAS /EXIT TO RASBOL... DSQSFS /...AT THIS ADDRESS / /WHEN THE REQUIRED RECORD HAS BEEN FOUND, THE /RASBOL-8 SECTION OF THE ROUTINE RETURNS TO HERE, /WHERE THE RECORD POSITION COUNT, INDICATING WHERE /THE REQUIRED RECORD IS TO BE FOUND, IS LOADED /INTO THE 36 BIT AC. THE INTERPRETER THEN CARRIES /ON TO THE NEXT MACRO INSTRUCTION OF THE PROGRAM / JMP DRDREX /TO READ ROUTINE EXIT / /CONSTANTS...READ SEQUENTIAL ROUTINE / REQREC=REQKEY DSQRWI=DRTSL3 DSQWKA=DRTSL2 DSQRPB=DRTSL4 / /THIS IS THE ERROR EXIT POINT FOR THE ROUTINES / RWRERR, CLA CLL CMA /SET -1 IN... DCA ACL /...LOW ORDER AC DCA CFP1 /CLEAR CURRENT... DCA CFP2 /...FILE POINTERS JMP SGN2 /TO EXIT / / /THIS ROUTINE CONTROLS THE OPERATIONS OF WRITING TO /THE DEVICE IN RANDOM, SEQUENTIAL OR ABSOLUTE MODE / /THE FIRST SECTION EXITS TO THE RASBOL-8 INSTRUCTIONS /WHICH SET UP THE RANDOM WRITE OPERATION / DWRANS, TAD RCDFI /SET CDF INSTRUCTION DCA ARG1F /FOR TRANSFER JMS GORAS /EXIT TO RASBOL... DWWLB /...AT THIS ADDRESS / /AFTER THE RASBOL SECTION HAS BEEN SUCCESSFULLY /COMPLETED, CONTROL IS RETURNED TO THIS POINT / DWRAN4, CLA CLL CML RAR /SET 4000 JMS I TVBLKO /TO WRITE BLOCK CLA CLL TAD DSQWOF /FETCH FLAG SNA CLA /WAS IT SET?
JMP I TVMBNT /NO...NORMAL EXIT JMP RWRERR /YES...NEAR FULL EXIT / / /THE SECOND SECTION EXITS TO THE RASBOL-8 ROUTINE /WHICH SETS UP THE SEQUENTIAL WRITE OPERATION / DWSEQS, TAD RCDFI /SET CDF INSTRUCTION DCA ARG1F JMS GORAS /EXIT TO RASBOL... DSEQWR /...AT THIS ADDRESS / /CONTROL RETURNS HERE WHEN THE RASBOL ROUTINE ENDS / JMP DWRAN4 /TO WRITE BLOCK / /CONSTANTS...WRITE ROUTINES / DSQWOF=DRTSL1 DWNUB=DRTSL2 DWNUW=DRTSL3 / / /THE NEXT ROUTINE EITHER OPENS A FILE FOR PROCESSING, /CLOSES IT AFTER PROCESSING, OR ALLOWS A FILE TO BE /READ IN ABSOLUTE MODE DEPENDING ON THE VALUE OF THE /RIGHT HAND SIX BITS OF THE RASBOL MACRO INSTRUCTION / OCRABR, TAD INSTRH /FETCH RIGHT HAND 6 BITS SNA /WAS IT ZERO? JMP OPENR /YES...TO OPEN ROUTINE CIA /NO...NEGATE IAC /ADD 1 SNA /WAS IT = 1? JMP CLOSER /YES...TO CLOSE ROUTINE IAC /NO...ADD 1 SNA CLA /WAS IT = 2? JMP ABSRWR /YES...READ ABSOLUTE JMP I TVMOER /NO...OBJECT ERROR / /RASBOL-8 MICRO PROGRAM - TAPE 20 / /THIS ROUTINE OPENS A FILE FOR PROCESSING / /FIRST THE FILE INFORMATION IS FETCHED / *R8ORG+4200 OPENR, TAD CRIA /FETCH ADDRESS DCA OPEN0 /SET AS ARGUMENT TAD RCDFI /SET CDF INSTRUCTIONS TAD CRIF DCA ARG1F TAD RCDFI DCA ARG2F JMS I TVBTST /FETCH DEVICE NAME... OPEN0, 0 /...AND FILE NAME TEXT FN1-1 -6 TAD ARG1F /FETCH CDF INSTRUCTION DCA OPEN1 /SET IT OPEN1, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH FILE POINTER ADDRESS DCA OPFPA /STORE IT CLL IAC /SET 1 TAD IR1 /ADD ADDRESS DCA CIWA /RESET INSTRUCTION ADDRESS TAD RCDFI /RESET CDF INSTRUCTION DCA ARG1F / /NOW FETCH OS/8 USER SERVICE ROUTINE AND LOCK IT IN CORE / CDF 0 CIF 10 JMS I (7700 /TO USER SERVICE ROUTINE 10 /FUNCTION 10: USRIN / /THE USER SERVICE ROUTINE IS NOW USED TO CHECK /WHETHER THE CORRECT DEVICE HANDLER IS IN CORE / CLA DCA CFP2 /CLEAR INTERNAL FILE POINTER TAD FN1 /SET DEVICE NAME AS ARGUMENT DCA OPEN2 TAD FN1+1 DCA OPEN3 CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 12 /FUNCTION 12: INQUIRE OPEN2, 0 /DEVICE... OPEN3, 0 /...NAME OPEN4, 0 /HANDLER ENTRY POINT JMP OPERR2 /ERROR RETURN CLA TAD OPEN4 /FETCH ENTRY POINT SZA CLA /HANDLER LOADED? JMP OPEN8 /YES...CONTINUE / /IF THE CORRECT DEVICE HANDLER WAS NOT IN CORE /IT IS NOW FETCHED WITH THE USER SERVICE ROUTINE / CDF 0 CIF 10 JMS GETPAG /TO FETCH HANDLER PAGE ADDRESS SNA /SPACE AVAILABLE? JMP OPERR2 /NO...ERROR DCA OPEN7 /YES...SET ADDRESS AS ARGUMENT TAD OPEN3 /FETCH DEVICE NUMBER CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 1 /FUNCTION 1: FETCH OPEN7, 0 /ADDRESS OF HANDLER JMP OPERR2 /ERROR RETURN CDF 0 CIF 10 JMS USFLAG /UPDATE SPACE FLAG
/ / /THE DEVICE IS TESTED FOR FILE STRUCTURE / OPEN8, JMS OFSTST / /THE FILE IS NOW LOOKED UP USING THE USER SERVICE /ROUTINE TO DETERMINE ITS STARTING POINT / TAD (FN1+2 /FETCH FILE NAME ADDRESS DCA OPEN10 /SET AS ARGUMENT TAD OPEN3 /FETCH DEVICE NUMBER CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 2 /FUNCTION 2: LOOKUP OPEN10, 0 /POINTER TO FILE NAME 0 JMP OPERR2 /ERROR RETURN / /THE FILE POINTER INFORMATION MAY NOW BE STORED / CLA TAD OPEN3 /FETCH DEVICE NUMBER DCA I OPFPA /STORE IT ISZ OPFPA TAD OPEN10 /FETCH BLOCK NUMBER DCA I OPFPA /STORE IT / /THE FILE INDEX INFORMATION IS NOW FETCHED FROM /THE OS/8 DIRECTORY ADDITIONAL INFORMATION WORDS / TAD OPEN11 /FETCH CDF INSTRUCTION DCA ARG1F /SET IT OPEN11, CDF 10 /SET DATA FIELD TO 1 CLA CLL CMA /SET -1 TAD I (1404 /FETCH NUMBER OF A.I.W. (-VE) TAD I (17 /ADD A.I.W. POINTER CDF 0 /RESET DATA FIELD DCA OPEN12 /SET AS ARGUMENT JMS I TVBTST /GET INDEX INFORMATION OPEN12, 0 IIDATE-1 -7 /INCLUDES DATE AND FILE LENGTH / /THE OPEN ROUTINE NOW CALCULATES THE NUMBER OF /THE FIRST EMPTY RECORD AVAILABLE IN THE FILE / TAD RCDFI /RESET CDF INSTRUCTION DCA ARG1F JMS GORAS /EXIT TO RASBOL... OPCALR /...AT THIS ADDRESS / /THIS IS THE START OF THE EXIT FOR THE OPEN ROUTINE / JMS I TVBTST /MOVE NUMBER TO 36 BIT AC TNRP1-1 ACH -2 OPEXA, CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 11 /FUNCTION 11: USROUT JMP I TVMBNT /EXIT / /OPEN ROUTINE...ERROR ROUTINES / /THE FIRST OCCURS IF AN ERROR IS ENCOUNTERED /WHILE FETCHING THE DEVICE HANDLER. THE ERROR / /THE SECOND OCCURS IF THE FILE SPECIFIED IN THE OPEN /INSTRUCTION IS NOT FOUND. THE MACRO AC IS SET TO -1 /AND CONTROL RETURNS TO THE NEXT RASBOL INSTRUCTION / OPERR2, CLA CLL CMA /SET -1 IN 36 BIT AC DCA ACH CMA DCA ACM CMA DCA ACL JMP OPEXA /TO OPEN ROUTINE EXIT / /CONSTANTS...OPEN ROUTINE PART 1 / FN1, ZBLOCK 6 OPFPA, 0 /
/RASBOL-8 MICRO PROGRAM - TAPE 21 / /THIS ROUTINE CLOSES A FILE AFTER PROCESSING / /FIRST THE FILE INFORMATION IS FETCHED / *R8ORG+4400 CLOSER, CLA CLL TAD CRIA /FETCH ADDRESS DCA CLOSE0 /SET AS ARGUMENT TAD RCDFI /SET CDF INSTRUCTIONS TAD CRIF DCA ARG1F TAD RCDFI DCA ARG2F JMS I TVBTST /FETCH FILE NAME TEXT CLOSE0, 0 FN1-1 -4 TAD ARG1F /FETCH CDF INSTRUCTION DCA CLOSE1 /SET IT CLOSE1, 0 /SET DATA FIELD TO FETCH TAD I IR1 /FETCH FILE POINTER ADDRESS DCA CLFPA /STORE IT CLA CLL IAC /SET 1 TAD IR1 /ADD ADDRESS DCA CIWA /RESET INSTRUCTION ADDRESS TAD RCDFI /RESET CDF INSTRUCTION DCA ARG1F / /NOW FETCH OS/8 USER SERVICE ROUTINE AND LOCK IT IN CORE / CDF 0 CIF 10 JMS I (7700 /TO USER SERVICE ROUTINE 10 /FUNCTION 10: USRIN / /THE USER SERVICE ROUTINE IS NOW USED TO CHECK /WHETHER THE CORRECT DEVICE HANDLER IS IN CORE / CLA CLL TAD I CLFPA /FETCH DEVICE NUMBER CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 12 /FUNCTION 12: INQUIRE CLOSE2, 0 JMP OPERR2 /ERROR RETURN CLA CLL TAD CLOSE2 /FETCH ENTRY POINT SNA CLA /HANDLER LOADED? JMP CLSERR /NO...ERROR / /THE DEVICE IS CHECKED FOR FILE STRUCTURE / TAD I CLFPA /YES...GET DEVICE NUMBER JMS TESTFS /TO TEST ROUTINE JMP CLFP3 /ERROR RETURN / /THE FILE IS NOW LOOKED UP USING THE USER SERVICE /ROUTINE SO THAT ITS INDEX INFORMATION WORDS MAY /BE MODIFIED WITH ANY CHANGES MADE DURING PROCESSING / TAD (FN1 /FETCH FILE NAME ADDRESS DCA CLOSE5 /SET AS ARGUMENT TAD I CLFPA /FETCH DEVICE NUMBER CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 2 /FUNCTION 2: LOOKUP CLOSE5, 0 /POINTER TO FILE NAME 0 JMP OPERR2 /ERROR RETURN / /THE INDEX INFORMATION WORDS IN THE FILE POINTER /ARE NOW SET UP AND WRITTEN BACK TO THE DIRECTORY / CLA CLL IAC RAL /SET 2 TAD CLFPA /ADD FILE POINTER ADDRESS DCA CLOSE7 /STORE TEMPORARILY CLOSE6, CDF 10 /SET DATA FIELD TO 1 TAD I (7666 /FETCH SYSTEM DATE CDF 0 /SET DATA FIELD TO 0 DCA I CLOSE7 /STORE IT IN F. I. B. CDF 10 /SET DATA FIELD TO 1 CLA CLL CMA /SET -1 TAD I (1404 /FETCH NUMBER OF A.I.W. (-VE) TAD I (17 /ADD A.I.W. POINTER DCA CLOSE8 /SET AS ARGUMENT CDF 0 /SET DATA FIELD TO 0 TAD CLOSE6 /FETCH CDF INSTRUCTION DCA ARG2F /SET IT CLA CLL IAC /SET 1
TAD CLFPA /ADD ADDRESS DCA CLOSE7 /SET AS ARGUMENT JMS I TVBTST /MOVE LATEST INDEX... CLOSE7, 0 /...INFORMATION TO... CLOSE8, 0 /...DIRECTORY SEGMENT -7 /INCLUDES DATE AND FILE LENGTH / /THE DIRECTORY SEGMENT IS NOW REWRITTEN / CDF 0 CIF 10 JMS I (REWDS /TO REWRITE DIRECTORY SEGMENT CLFP3, CDI 0 /RESET BOTH FIELDS JMS I TVCLAM /CLEAR 36 BIT AC-MQ JMP OPEXA /TO EXIT / /CONSTANTS...CLOSE ROUTINE / CLFPA, 0 / /CLOSE ROUTINE...ERROR EXIT / CLSERR, JMS GORAS /TO RASBOL AT... CLERMS /...THIS ADDRESS JMP OPERR2 /TO ERROR / / /THIS SUBROUTINE TRANSFERS CONTROL TO THE /RASBOL-8 INTERPRETER FROM WITHIN ITSELF / GORAS, 0 CLA CLL JMS I TVBTST /SAVE "CRIA", "CRIF" & "CIWA" CRIA-1 SVCRIA-1 -3 CLA CLL TAD I GORAS /FETCH ADDRESS DCA CIWA /SET IT DCA CRIF /CLEAR FIELD ISZ GORAS /INDEX FOR NORMAL RETURN JMP I TVMBNT /EXIT TO RASBOL-8 / /THIS SUBROUTINE RETURNS CONTROL TO WHERE IT WAS /INTERRUPTED IN THE PAL-III PORTION OF THE MICRO /IF THE 36 BIT AC IS ZERO. OTHERWISE THE ROUTINE /RETURNS CONTROL TO THE ADDRESS IN LOW ORDER AC. / RETRAS, 0 CLA CLL JMS I TVBTST /RESET "CRIA", "CRIF" & "CIWA" SVCRIA-1 CRIA-1 -3 CLA CLL TAD ACL /FETCH LOW ORDER AC SNA /WAS IT ZERO? JMP I GORAS /YES...NORMAL RETURN DCA GORAS /NO...SET ADDRESS DCA ACL /CLEAR ADDRESS FROM AC JMP I GORAS /RETURN TO ADDRESS FROM AC / /CONSTANTS...CONTROL TRANSFER ROUTINES / SVCRIA, ZBLOCK 3 /
*R8ORG+4600 /RASBOL-8 MICRO PROGRAM - TAPE 18 / /THIS ROUTINE PERFORMS ONE OF THE FUNCTIONS /NOP, CLEAR, NEGATE, REMAIN, EXIT, DATE, /WRITE RANDOM, WRITE SEQUENTIAL OR ABSOLUTE /BYTE SWAP, PRINT OCTAL,FILL ZERO,FILL SPACE /PRINT-CHAR,EXECUTE(X3), /DEPENDING ON THE VALUE OF THE RIGHT HAND /SIX BITS OF THE RASBOL MACRO INSTRUCTION / NCNR, TAD INSTRH /FETCH RIGHT HAND 6 BITS TAD (-16 /SUBTRACT 16 SMA SZA CLA /WAS CODE > 16? JMP I TVMOER /YES...TO OBJECT ERROR TAD INSTRH /NO...FETCH R.H. 6 BITS TAD (JMP I LIST2 /ADD "JMP" INSTRUCTION DCA .+1 /SET INSTRUCTION 0 /BRANCH TO ROUTINE LIST2, START /NOP...CODE 00 CLACR /CLEAR...CODE 01 NGATER /NEGATE...CODE 02 SWAPR2 /REMAIN...CODE 03 EXITR /EXIT...CODE 04 LINACR /LINE COUNT TO ACC. DWRANS /WRITE RANDOM...CODE 06 DWSEQS /WRITE SEQUENTIAL...CODE 07 ABSRWR /WRITE ABSOLUTE...CODE 10 RBSWR /RBSW 11 PRNTOR /OCTAL PRINT 12 FILLZO /FILZRO 13 FILLBL /FILSPC 14 RPRNCH /PRNTCH 15 EXEC3R /EXECX3, EXEC. X3 AS INSTR. / / /THIS ROUTINE COMPLEMENTS THE 36 BIT ACCUMULATOR / NGATER, JMS I TVCOMP /COMPLEMENT 36 BIT AC ACH JMP I TVMST /EXIT / /THIS ROUTINE SWAPS THE 36 BIT AC WITH THE 36 BIT MQ / SWAPR, SWAPR2, JMS I TVSWAM /TO SWAP ROUTINE JMP I TVMST /EXIT / /THIS ROUTINE RETURNS CONTROL TO THE OS/8 MONITOR / EXITR, CDF CIF 0 JMP I (7600 /RETURN TO OS/8 /ABORT BY CONTR.C. ADDRESS ABORTN, TAD ABORA SNA JMP EXITR DCA CIWA TAD ABORF DCA CRIF JMP I TVMBNT ABORF, 0 ABORA, 0 /SET UP ABORT ADDRESS ABORTI, TAD F1 DCA ABORF TAD ARG1 DCA ABORA JMP I TVMST / /SHIFT RIGHT INSTR. RRTRR, CLA CLL TAD INSTRH AND (17 CIA DCA COUNT RRT2, TAD ACM CLL RAR DCA ACM TAD ACL RAR DCA ACL ISZ COUNT JMP RRT2 JMP I TVMST / /RASBOL-8 MICRO PROGRAM - TAPE 22 / /DO LOOP INSTR.(5 WORD INSTR) DOLOPR, TAD MSDFI /FIELD OF INSTR DCA .+1 0 TAD I CIWA /GET LIMIT WORD DOL2, CIA DCA ERS0 CDF 0 ISZ CIWA /ADDRESS + 1 TAD ARG2F DCA .+1 0 TAD I ARG2 TAD ERS0 /IS IT LIMIT? SNA CLA /NO JMP I TVRAXT /YES TAD I ARG2 TAD COUNT /INCREMENT BY COUNT DCA I ARG2 JMP GOTOR /DOVAR, DO LOOP VARIABLE(5 WD. INSTR.) DOVARR, TAD MSDFI DCA .+1 0 TAD I CIWA /ADDRESS OF ARG 4 DCA ERS0 TAD ARG2F DCA .+1 0 /FIELD OF LIMIT TAD I ERS0 JMP DOL2
*R8ORG+5000 /ACCU DOUBLE WORD DIVIDE BY SINGLE WORD UNSIGNED IN DVSOR /RESULT IN ACCU, REMAINDER IN MQL DVSOR, 0 DVD1, 0 DCA MQL DCA MQH TAD ACM CMA DCA MQM /NEGATIVE DCA ACL /CLEAR ACC DCA ACM TAD DVSOR SNA /CHECK FOR ZERO DIVISOR JMP I DVD1 CIA DCA DVSOR DVD2, CLL TAD DVSOR TAD MQL SZL JMP DVD4 JMS I TVFAIL ISZ MQM JMP DVD4 /DECREMENT HI.ORD.WORD CLA CLL TAD ACL JMP I DVD1 /FINISHED DVD4, DCA MQL ISZ ACL /RESULT JMP DVD2 JMP I DVD1 /THIS RASBOL-8 SUBROUTINE CALCULATES THE RECORD /NUMBER OF THE FIRST UNUSED RECORD IN THE FILE / CALFUR, ZBLOCK 2 MOVE1 ;IIRECL ;DVSOR LOADIM ;400 /SET 256 GOPAL ;DVD1 /DIVIDE BY RECORD LENGTH STORE1 ;RPB /STORE RECORDS/BLOCK LOAD1 ;IIFUBN /GET BLOCK NUMBER MULT1 ;RPB /MULTIPLY BY REC./BLOCK STORE2 ;NREC /STORE NUMBER OF RECORDS MOVE1 ;IIRECL ;DVSOR LOAD1 ;IIFUWN /GET WORD NUMBER GOPAL ;DVD1 ADDIM ;1 /ADD 1 ADD2 ;NREC /ADD NUMBER OF RECORDS GOTO ;CALFUR /RETURN / /CONSTANTS...CALCULATION SUBROUTINE / NREC=DRTSL2 RPB=DRTSL1 /THIS IS THE SECOND PART OF THE OPEN ROUTINE WHICH /USES A SECTION OF RASBOL-8 INSTRUCTIONS TO CALCULATE /THE NUMBER OF THE FIRST UNUSED RECORD IN THE FILE / OPCALR, GOSUB ;CALFUR /TO CALCULATE ROUTINE OPOUT, STORE2 ;TNRP1 /STORE NUMBER LOADX2 ;OPFPA MOVE ;IIDATE ;1 ;7 /FILE INFO. TO F.I.B. GOTO ;RFRAS /RETURN TO MICRO / / /RASBOL-8 MICRO PROGRAM - TAPE 23 / /THIS ROUTINE WRITES A RECORD TO A FILE /WHICH MAY BE EITHER RANDOM OR SEQUENTIAL. /THE ROUTINE IS ACTUALLY WRITTEN IN RASBOL-8 / DSEQWR, CLEARW ;DSQWOF /CLEAR OVERFLOW FLAG LOAD1 ;IIFUWN /FETCH WORD NUMBER ADD1 ;IIRECL /ADD RECORD LENGTH STORE1 ;DWNUW /STORE AS NEW NUMBER ADD1 ;IIRECL SUBTIM ;400 /SUBTRACT 256 GOIF ;DWCONT ;DWCONT LOAD1 ;IIFUBN ADDIM ;1 STORE1 ;DWNUB DWSNII, MOVE1 ;DWNUB ;IIFUBN /SET NEW BLOCK NUMBER CLEARW ;DWNUW /ZERO TO NEW WORD DWCONT, MOVE1 ;DWNUW ;IIFUWN /SET NEW WORD NUMBER LOADX2 ;CFPA MOVE2 ;IIFUBN ;4 /NEW INFO. TO F.I.B. LOAD1 ;IINBFM SIGN1 ADD1 ;DWNUB ADDIM ;1 ADD1 ;IINBI GOZERO ;EXFULL DWWLB, MOVE1 ;CFP1 ;CTDEV /SET DEVICE NUMBER MOVE1 ;CFRBA ;CTBLK /SET BLOCK NUMBER GOTO ;RFRAS /RETURN TO MICRO / /IF THE INSTRUCTION WAS A "WRITE SEQUENTIAL" AND, /IN UPDATING THE INDEX, THE FIRST UNUSED BLOCK /IS DISCOVERED TO BE GREATER THAN OR EQUAL TO THE /LAST BLOCK IN THE FILE, AN ERROR EXIT IS TAKEN. / /IF THE BLOCK NUMBER IS GREATER THAN THE LAST BLOCK /IN THE FILE, THE MACRO 36 BIT AC IS SET TO -1 AND /THE ROUTINE EXITS WITHOUT WRITING THE BLOCK. / /IF THE BLOCK NUMBER IS EQUAL TO THE LAST BLOCK /IN THE FILE, THE OVERFLOW FLAG IS SET AND THE /ROUTINE PROCEEDS TO WRITE THE BLOCK. AFTER THE /BLOCK IS WRITTEN ,THE 36 BIT AC IS SET TO -1 /TO WARN THE USER AND THE ROUTINE EXITS. / EXFULL, INCREM ;DSQWOF /SET OVERFLOW FLAG GOTO ;DWWLB /BACK TO MAIN ROUTINE / / /THIS ROUTINE, WRITTEN IN RASBOL-8, IS /THE ACTUAL SEQUENTIAL READ ROUTINE / /BEGIN BY FETCHING THE INDEX INFORMATION / DSQSFS, LOADX1 ;DSQSFX MOVE2 ;0 ;CFP1 /GET FIRST 2 WORDS MOVE3 ;ACH ;REQREC /SAVE RECORD POINTER
LOADX1 ;DSQSFX MOVE ;2 ;IIDATE ;7 /GET NEXT 7 WORDS DSQSF, LOAD2 ;CFP1 /GET BLOCK PARAMETERS ADD1 ;IINBI /ADD NUMBER OF INDEX BLOCKS STORE2 ;CTDEV /SET BLOCK PARAMETERS / /CALCULATE NUMBER OF RECORDS IN A 256 WORD BLOCK / DSQSFB, MOVE1 ;IIRECL ;DVSOR LOADIM ;400 /SET 256 GOPAL ;DVD1 /DIVIDE BY RECORD LENGTH STORE1 ;DSQRPB /STORE AS REC./BLOCK / /CALCULATE POSITION OF REQUIRED RECORD / DSQCRP, MOVE1 ;DSQRPB ;DVSOR LOAD ;REQREC /GET REC NO GOZERO ;DSQGNU SUBTIM ;1 /SUBTRACT 1 GOPAL ;DVD1 /NO...DIVIDE BY NO OF RECS STORE1 ;DSQWKA /STORE AS NO OF BLOCKS REMAIN /FETCH REMAINDER MULT1 ;IIRECL /MULTIPLY BY REC LENGTH STORE1 ;DSQRWI /STORE AS WORD INDEX LOAD1 ;IINBFM /GET NO OF BLOCKS (-VE) SIGN1 /SET SIGN ADD1 ;IINBI /ADD NO OF INDEX BLOCKS ADD1 ;DSQWKA /ADD NO OF BLOCKS (CALC.) GOZERO ;DGLTI3 /OVERFLOW? GOPOS ;DGLTI3 /YES...ERROR DSQSET, LOAD1 ;DSQWKA /GET NO OF BLOCKS ADDTO1 ;CTBLK /ADD TO BLOCK NUMBER / / /AT THIS POINT THE REQUIRED RECORD HAS BEEN FOUND /AND THE RELEVANT INFORMATION ABOUT IT IS STORED /FOR FUTURE REFERENCE BY THE MICRO. BEFORE THE BLOCK /IS READ AND THE ROUTINE EXITS TO THE INTERPRETER, /THE BLOCK IS CHECKED TO SEE IF IT IS ALREADY IN CORE. /IF IT IS, THE READ IS BYPASSED. / DSQEXT, MOVE1 ;DSQRWI ;CFRWI /SAVE REC. WORD INDEX COMPAR ;CTBLK ;CFRBA ;1 /SAME BLOCK AS BEFORE? GONZRO ;DSQEX2 /NO,READ BLOCK DSQEX1, COMPAR ;CTDEV ;LSDEV ;1 /SAME DEV. AS BEFORE? GOZERO ;RFRAS /YES...RETURN TO MICRO DSQEX2, CLEAR /CLEAR AC GOPAL ;BLOKOP /FETCH BLOCK GOTO ;RFRAS /RETURN TO MICRO / /IF THE REQUIRED RECORD NUMBER WAS ZERO, /FETCH THE NEXT EMPTY RECORD IN THE FILE / DSQGNU, GOSUB ;CALFUR /CALCULATE RECORD NUMBER STORE ;REQREC /STORE IT STORE2 ;TNRP1 /STORE AS LAST RECORD GOTO ;DSQSFB /CONTINUE /
/RASBOL-8 MICRO PROGRAM - TAPE 24 / /THIS ROUTINE, WRITTEN IN RASBOL-8, /IS THE ACTUAL RANDOM READ ROUTINE / /BEGIN BY FETCHING THE INDEX INFORMATION / DSQSFX, 0 DGSFSX, 0 SUBNCX, 0 DGSFS, LOADX1 ;DGSFSX MOVE2 ;0 ;CFP1 /GET FIRST 2 WORDS MOVE3 ;ACH ;REQKEY /SAVE RECORD POINTER LOADX1 ;DGSFSX MOVE ;2 ;IIDATE ;7 /GET NEXT 7 WORDS DGSF, INCREM ;DREADF /SET 1 IN FLAG MOVE2 ;CFP1 ;CTDEV /SET BLOCK PARAMETERS MOVIM ;1 ;SUBNCX /SET NUMBER CHECKED / /TEST REQUIRED KEY TO SEE IF IT IS LESS /THAN THE LOWEST KEY IN THE INDEX BLOCK / DGGIB, CLEAR GOPAL ;BLOKOP /FETCH INDEX BLOCK COMPAR ;FILBLK ;REQKEY ;3 /INDEX LOWEST : REQUIRED GOZERO ;DGGDBS GOPOS ;DGLIL2 /PROC.LOWEST DGG2, COMPAR ;FILBLK+374 ;REQKEY ;3 /INDEX HIGHEST : REQUIRED GONEG ;DGG3 /<,SEARCH GOPOS ;DGIBS /LOCATE DATA BLOCK LOADIM ;2 /SET 2 ADDTO1 ;DREADF /ADD TO FLAG DGG3, LOADIM ;125 /SET 85 ADDTO1 ;DGDBK /ADD TO DATA BLOCK COUNT DECGOZ ;DGG4 ;DREADF /CLEAR "1ST" FLAG CLEARW ;DREADF /CLEAR "EQUAL" FLAG GOTO ;DGLIL2 /GET BLOCK DGG4, LOAD1 ;IINBI /GET NO. OF INDEX BLOCKS SUBNC, SUBT1 ;SUBNCX /SUBTRACT NUMBER CHECKED GOIF ;DGGDBS ;DGGDBS /GET BLOCK IF NO MORE INCREM ;SUBNCX /NUMBER CHECKED + 1 INCREM ;CTBLK /BLOCK NUMBER + 1 INCREM ;DREADF GOTO ;DGGIB /GET NEXT INDEX BLOCK / /THIS ROUTINE TAKES THE APPROPRIATE ACTION IF THE /REQUIRED KEY IS LESS THAN THE LOWEST IN AN INDEX / DGLIL2, GOIFZO ;DGLTI3 ;DGDBK DECREM ;DGDBK /DATA BLOCK COUNT - 1 DGLTIL, GOTO ;DGGDBS /GET BLOCK DGLTI3, LOADIM ;RWRERR /SET ERROR ADDRESS GOPAL ;RETRAS /RETURN TO MICRO / /IF THE REQUIRED KEY WAS LESS THAN THE HIGHEST IN AN /INDEX BLOCK, THAT INDEX BLOCK IS SEARCHED TO LOCATE /THE DATA BLOCK IN WHICH THE REQUIRED RECORD IS STORED / DGIBS, CLEARW ;DREADF /CLEAR FLAG MOVIM ;FILBLK+3 ;DGIBSL+2 /SET KEY ADDRESS
DGIBSL, COMPAR ;REQKEY ;0 ;3 /COMPARE KEYS GOIF ;DGGD2 ;DGGDBS /= GET NEXT: < GET THIS LOADIM ;3 /> SET 3 ADDTO1 ;DGIBSL+2 /ADD TO KEY ADDRESS INCREM ;DGDBK /DATA BLOCK COUNT + 1 GOTO ;DGIBSL /BACK FOR NEXT COMPARE / /THE DATA BLOCK CONTAINING THE REQUIRED RECORD IS NOW FETCHED / DGGD2, INCREM ;DGDBK /DATA BLOCK COUNT + 1 DGGDBS, LOAD1 ;CFP2 /SET START BLOCK ADD1 ;IINBI /ADD NO. OF INDEX BLOCKS ADD1 ;DGDBK /ADD DATA BLOCK COUNT STORE1 ;CTBLK /SET AS CURRENT BLOCK CLEAR GOPAL ;BLOKOP /READ DATA BLOCK / /THE DATA BLOCK IS NOW SEARCHED TO DETERMINE /THE POSITION OF THE REQUIRED RECORD WITHIN IT / GOIFZO ;DGERKL ;IIKEYL /ERROR IF KEY LENGTH 0 LOAD1 ;IIKEYL /GET KEY LENGTH SUBTIM ;3 /SUBTRACT 3 GOIF ;DGSB ;DGSB /BRANCH IF O.K. DGERKL, PRINT 4 ;TEXT '_KEY' /PRINT MESSAGE LOADIM ;MOBERR /SET ADDRESS GOPAL ;RETRAS /RETURN TO MICRO DGSB, MOVE1 ;IIKEYL ;DGFRK+3 /SET KEY LENGTH CLEARW ;DGRPK /CLEAR RECORD POSITION COUNT MOVIM ;FILBLK+1 ;DGFRK+1 /SET RECORD KEY ADDRES LOADIM ;3 /SET 3 SUBT1 ;IIKEYL /SUBTRACT KEY LENGTH ADDIM ;REQKEY /ADD KEY ADDRESS STORE1 ;DGFRK+2 /SET REQ. KEY ADDRESS DGFRLP, LOADIM ;400 /SET 256 SUBT1 ;IIRECL /SUBTRACT RECORD LENGTH SUBT1 ;DGRPK /SUBTRACT RECORD POSITION GONEG ;DGLTI3 /= O.K. < ERROR DGFRK, COMPAR ;0 ;0 ;0 /> O.K. COMPARE KEYS GOZERO ;DGEXIT /= FOUND: < CHECK NEXT GOPOS ;DGLTI3 /> ERROR: NOT FOUND LOAD1 ;IIRECL /FETCH RECORD LENGTH ADDTO1 ;DGFRK+1 /ADD TO KEY POINTER ADDTO1 ;DGRPK /ADD TO RECORD POSITION COUNT GOTO ;DGFRLP /BACK FOR NEXT RECORD / /AT THIS POINT THE REQUIRED RECORD HAS BEEN /FOUND. THE RELEVANT INFORMATION IS STORED /FOR FURTHER REFERENCE BY THE MICRO BEFORE /THE ROUTINE EXITS TO THE MAIN INTERPRETER. / DGEXIT, CLEARW ;LSDEV /FORCE RE-READ MOVE1 ;DGRPK ;CFRWI /STORE RECORD WORD INDEX CLEARW ;DREADF /CLEAR FLAG GOTO ;RFRAS /RETURN TO MICRO /
/RASBOL-8 MICRO PROGRAM - TAPE 25 / /THIS SUBROUTINE PROVIDES THE OPEN ROUTINE WITH THE /ADDRESS OF THE NEXT AVAILABLE PAGE FOR A DEVICE /HANDLER OR WITH ZERO IF NO MORE PAGES ARE LEFT / FIELD 1 *7501 GETPAG, 0 CLA CLL RDF /READ DATA FIELD TAD RDSCFI /ADD INSTRUCTION DCA GPEX /SET IT GETPA2, TAD LIST3 /GET FLAG SNA /IS IT SET? JMP GPEX /NO...NO ROOM...EXIT TAD GETPA2 /YES...ADD INSTRUCTION DCA .+2 /SET IT CLA CLL 0 /GET PAGE ADDRESS GPEX, 0 /RESET FIELD JMP I GETPAG /RETURN / /CONSTANTS / DHALST, 6401 / 06400 - TWO PAGES 6601 / 06600 - TWO PAGES 7000 / 07000 - ONE PAGE LIST3, -3 / / /THIS SUBROUTINE UPDATES THE SPACE AVAILABLE FLAG /AFTER EACH DEVICE HANDLER HAS BEEN FETCHED / USFLAG, 0 CLA CLL RDF /READ DATA FIELD TAD RDSCFI /ADD INSTRUCTION DCA USFEX /SET IT CLA CLL CMA /SET -1 TAD 37 /ADD TABLE ADDRESS TAD OPEN3 /ADD DEVICE NUMBER DCA TABPNT /SET AS POINTER CDF 10 /SET DATA FIELD TO 1 TAD I TABPNT /FETCH D.H.I. WORD SPA CLA /TWO PAGE? IAC /YES...SET 2 IAC /NO...SET 1 TAD LIST3 /ADD FLAG DCA LIST3 /RESTORE IT USFEX, 0 /RESET FIELD JMP I USFLAG /RETURN / /CONSTANT / TABPNT, 0 / / /THIS SUBROUTINE IS USED TO REWRITE THE DIRECTORY /SEGMENT AFTER MODIFYING THE INDEX INFORMATION / REWDS, 0 CLA CLL RDF /READ DATA FIELD TAD RDSCFI /ADD CDI INSTRUCTION DCA REWDSX /SET FOR EXIT CDF 10 /SET DATA FIELD TO 1 TAD 7 /GET DIRECTORY KEY WORD AND (7 /EXTRACT SEGMENT NUMBER DCA SEGNUM /SET AS ARGUMENT CIF 0 /SET INSTRUCTION FIELD TO 0 JMS I 51 /TO DEVICE HANDLER 4210 /WRITE 2 PAGES (FIELD 1)... 1400 /...FROM HERE... SEGNUM, 0 /...TO HERE JMP .+3 /ERROR RETURN REWDSX, 0 /RESET INSTRUCTION FIELD JMP I REWDS /RETURN TO CLOSE ROUTINE CDI 10 /SET BOTH FIELDS TO 1 JMS I (200 /TO USER SERVICE ROUTINE 11 /FUNCTION 11: USROUT RDSCFI, CDI 0 /SET INSTRUCTION FIELD TO 0 JMP I (BOBN3 /TO INDICATE ERROR / $