File RASNU.

Directory of image this file is from
This file as a plain text file


/RASTIM MICRO PROGRAM /START OF USERS PROGRAM AREA ADDRESSES STAFZ1=2 STARZ1=0000 /USER 1=20000 STAFZ2=3 STARZ2=0000 /USER 2=30000 / / EXTENDED SYMBOLS - JANUARY 1977 / /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 / /RASTIME INSTRUCTION SET / 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 EXECX3=0016 / LINC2AC=0017 / OUTONE=0020 / OUTTWO=0021 / OUTBOTH=0022 / SYSDATE=0023 /*** WAIT=0024 /*** SLEEP=0025 DATE=0026 /*** READAB=0027 GOACC=0030 GOSACC=0031 USERNUM=0032 / TYPIN=0100 / TYPCH=0100 / PRINTN=0140 PRINTD=0160 PRINT=0200 SIGN1=0310 SIGN2=0320 SHIFTR=0340 / MULTX1=0400 / MULTX2=0500 / STORX1=0610 / STORX2=0620 / STORX3=0630 / STORLC=0640 / CLEARLC=0650 / STORL2=0660 / CLRLC2=0670 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 / WAITIN=2010 / WAITOUT=2020 / ORIM=2100 / SEARCH=2110 / HSEARCH=2120 / GETREC=2200 / PUTREC=2300 GOTO=3000 GOZERO=3010 GOPOS=3020 GONEG=3030 GONZRO=3040 GOSUB=3100 GSZERO=3110 GSPOS=3120 GSNEG=3130 GSNZRO=3140 GOPAL=3200 LOADX1=3310 LOADX2=3320 LOADX3=3330 LOADLC=3340 LOADL2=3360 / YESNO=3500 / ABORT=3510 / POWER=3520 / PRINTC=3600 / SEARCH=3610 / HSEARCH=3620 / 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 ADDWIM=5101 CLRWDS=5200 MOVE1=5300 MOVE2=5400 MOVE3=5500 GOIFEQ=5600 MOVE=6200 COMPAR=6300 / CONV6W=6400 / CONVW6=6500 GOWDEQ=6600 / PICTUR=7000 FILL=7100 RANGE=7300 /*** CHANNEL=7500 DOVAR=7600 DO=7700 /CONSTANTS /*** OPENLOCK=0 /*** OPEN=1 /*** CLOSEQ=2 /*** CLOSE=3 /*** CHAIN=4 /*** OVERLAY=5 /*** SAVE=6 /*** OS8ENTER=7 /*** OS8CLOSE=10 /8 /*** GETAIW=11 /9 /*** PUTAIW=12 /10 XAREA=7200 TAB=0211 BELL=0207 FF=0214 VT=0213 SPACE=0240 CRET=215 LF=212
/RASBOL-8 MICRO PROGRAM / /WRITTEN BY: NOEL K. GODDARD / AND: ROYCE A. SMITH / /DATE: JANUARY 1973 /AND AMMENDED TO RASTIM JAN.1978 /FOR: RASMITH INDUSTRIAL SYSTEMS / ALIAS, SYSTEMS-EIGHT / 30 BURRANEER AVENUE / ST IVES N.S.W. 2075 / /THIS PROGRAM IS DESIGNED TO OPERATE IN AN /EMULATIVE 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 /FETCHED AND EXECUTED BY THE MICRO PROGRAM / / / /DEFINE ASSEMBLY SWITCHES / DECWRIT=0 HWTABS=1 /PAGE ZERO LOCATIONS FIELD 0 *0 JMP I .+1 PFRSEN *6 PFAIL, 0 /POWER FAIL, TIMESHARE ROUTINE JMP PFAIL2 /AUTO INCREMENT REGISTERS *10 IR1, 0 IR2, 0 IR5, 0 / / / / / / *20 OPCODE, 0 /PSEUDO OPCODE BITS 0-5 INSTRH, 0 /BITS 6-11 / GENERAL WORK AREAS ACCH, 0 ACCM, 0 ACCL, 0 SRH, 0 SRM, 0 SRL, 0 SR1H, 0 SR1M, 0 SR1L, 0 ERS0, 0 ERS1, 0 ERS2, 0 SFLAG, 0 SFLAG1, 0 /DISK WORK AREAS CTDEV, 0 /DEVICE CTBLK, 0 /BLOCK NO. DRTSL1, 0 DRTSL2, 0 DRTSL3, 0 DRTSL4, 0 REQKEY, 0;0;0 /KEY /MAIN ROUTINE ENTRY ADDRESS TVMOER,MOBERR /OBJECT ERROR TVBLKO,BLOKOP /DISK BLOCK READ,WRITE TVRAXT,RAEXIT /RESTORE ACCU. NEXT INSTR. TVSTOR,STORER TVLODR,LODER TVCLAM,CLAM TVSWAM,SWAM TVADDS,ADDS TVTMPY,TMPY TVCOMP,COMP TVTDIV,TDIV TVCBCH,CBCH TVCIAC, CIAC /COMPL,INCR,STORE IN COUNT TVPRNT,PRNT TVCMPA,CMPA TVPDPR,PDPR TVOBTN,OBTN TVPRCH,PRNCH TVABC,ABC TVFAIL,PFAIL TRACEP, TRACER TRACE=JMS I TRACEP / /REVERSE COUNT RCOUNT, 0 TAD COUNT SNA IAC /ZERO NOT ALLOWED JMS I TVCIAC JMP I RCOUNT /SET INPUT MASK, RETURN ADDRESS NEXT, JMP NNEXT K7,7 K77,77 VTINC,RTINC TINC=JMS I VTINC VTIN,RTIN TIN=JMS I VTIN VDINC,RDINC DINC=JMS I VDINC VDIN,RDIN DIN=JMS I VDIN X1, 0 X2, 0 X3, 0 /MACRO INDEX REGISTERS *135 LINKNT, 0 /LINE COUNT PRINTER 1 LINKN2, 0 /" " TWO MFLAG, 0 /MULTIPLY LAST FLAG / NARG, 1 /FIELD OF NEXT INSTR. OR ARG. NARGW, 0 /ADDR. OF NEXT INSTR. OR ARG. FILCHA, 0 /FILL CHARACTER FOR INPUT F1, 0 /FLD OF ARG1 ARG1, 0 /ARGUMENT 1 F2, 0 /FLD OF ARG2 ARG2, 0 COUNT, 0 /ARG 3 OR COUNTER ZZPFL, 0;0 /POWER FAIL GOSUB ZZABOR, 0;0 /^C ABORT GOTO ZWPRNT, 1 /WHICH PRINTER IS ON INST, 0 /INSTRUCTION BEING EMULATED ACH, 0 ACM, 0 ACL, 0 /MAIN ACCUMULATOR MQH, 0 /MUST FOLLOW ACL. MQM, 0 MQLO, 0 /REMAINDER, OVERFLOW ACCUMULATOR / / / /IN THIS MULTI-PROGRAMMING VERSION OF RASBOL-8 THE FOLLOWING /CONDITIONS ARE ESTABLISHED. THE TWO /PAGES FROM 07200 UPWARDS ARE RESERVED FOR THE DATA BLOCK.
/THE THREE PAGES 06400 TO 07177, ARE SET /ASIDE FOR ANY COMBINATION OF ONE AND TWO PAGE DEVICE HANDLERS / / XAREA=7200 /TWO PAGES FOR DATA BLOCK / / /RASBOL-8 MICRO PROGRAM - TAPE 2 / /THE FIRST SECTION OF THE MICRO IS SIMPLY INITIALISATION / FIELD 0 *200 /** ** ** ** ** ** 7000 /NORMAL START IS NOP TLS KCC / /THE NEXT SECTION OF THE MICRO SEPARATES THE VARIOUS /PARTS OF THE FIRST 12 BITS OF THE MACRO INSTRUCTION / NNEXT, CLA CLL START, CAM /CLEAR HARDWARE AC-MQ DCA MFLAG /CLEAR MULTIPLY FLAG MLSTRT, TINC ;NARG /GET NEXT INSTR. DCA INST DCA COUNT /CLR. JMS I TVFAIL START2, TAD INST /DISSECT INSTR. AND K7 DCA F1 TAD INST RTR RAR AND K7 DCA F2 TAD INST BSW AND K77 DCA OPCODE TAD INST AND K77 DCA INSTRH / SAVE ACC. TAD ACH DCA ACCH TAD ACM DCA ACCM TAD ACL DCA ACCL JMP TEST TRANS, TAD (JMP I TABLE /NO...FETCH TABLE START ADDRESS TAD OPCODE /ADD OPCODE DCA .+1 /SET EXIT INSTRUCTION 0 /TO EXECUTION ROUTINE / / /EXECUTION ROUTINES ENTRY ADDRESSES VECTOR / 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 GOTOR1 GOPALR LOADXR START YESNOR PRNTCR DREADR TYPTR TYPWR PRUR PRNTXR PRNTWR GIFELR INCGZR DECGZR GOIFZR MOVIMR CLRWDR MOV1R MOV2R MOV3R GOIFQR START START START MOVETR CMPARE CNV6WR CNVW6R 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 / PAGE /** ** ** ** ** **/400 TEST, TAD OPCODE TAD (-10 SPA CLA /<10 JMP TRANS /YES,NO ARGS TAD X1 TINC ;NARG /GET FIRST ARG DCA ARG1 SZL ISZ F1 /OVER 4K DCA X1 /CLR TAD OPCODE TAD (-40 SPA CLA JMP TRANS TAD X2 TINC ;NARG /GET SECOND ARG DCA ARG2 SZL ISZ F2 DCA X2 TAD OPCODE TAD (-60 SPA CLA JMP TRANS /ONLY 2 ARGS TAD X3 TINC ;NARG /COUNT DCA COUNT DCA X3 JMP TRANS
/ /COMPL,INCR,AC, PUT IN COUNT CIAC, 0 CIA DCA COUNT JMP I CIAC / 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 MQLO DCA ACL TAD COUNT DCA MQLO JMP I SWAM / /GO VIA ACC. GOVACR, JMS GOACCR JMP GOTOR /GOSUB VIA ACC. GOSACR, JMS GOACCR JMP GOSUBR GOACCR, 0 TAD ACL DCA ARG1 TAD ACM AND K7 DCA F1 JMP I GOACCR / / /THIS ROUTINE INCREMENTS, DECREMENTS /OR CLEARS A SPECIFIED WORD IN CORE / IDCWR, CLA CLL CMA /-1 TAD F2 CIA SNA JMP .+3 TIN ;F1 DIN ;F1 JMP NEXT /
/GOZERO,GOPOS,GONEG,GONZRO GOSIGN, TAD F2 TAD (-2 SPA /2,3 JMP IDGOIC SPA SNA CLA /3 JMP GOPOSR /GOPOS,2 TAD ACH SPA CLA JMP GOTOR /GONEG CLA CLL CMA RTL /-3 TAD F2 SPA CLA SNA /4 JMP NEXT JMP GOPOSR /THIS ROUTINE PERFORMS A BRANCH /IN THE MACRO PROGRAM GOTOR1, TAD F2 SZA CLA JMP GOSIGN /GOZERO,GOPOS,GONEG,GONZRO GOTOR, CLA TAD OPCODE TAD (-31 /GOSUB? SNA CLA /NO JMP GOSUBR GOTOR2, CLA CLL TAD F1 /FETCH FIELD DCA NARG /SET IT TAD ARG1 /FETCH ADDRESS DCA NARGW /SET IT JMP NEXT / / /THIS ROUTINE PERFORMS A SUBROUTINE /JUMP IN THE MACRO PROGRAM / GOSUBR, TAD NARG /FETCH CURRENT FIELD TAD (GOTO /ADD "GOTO" INSTRUCTION DINC ;F1 /PUT AT ADDR. TAD NARGW DINC ;F1 /PUT AT ADDR.+1 JMP GOTOR2 /TO BRANCH / / PAGE /** ** ** ** ** **/ 600 /THIS ROUTINE BRANCHES TO A "PAL" SUBROUTINE /EMBEDDED IN A RASBOL-8 PROGRAM / GOPALR, TAD F1 /FETCH F1 RAL CLL RTL TAD (CIF /ADD CIF INSTRUCTION DCA GP2 /SET CIF INSTRUCTION TAD ACL /LOAD ACCU GP2, 0 /CHANGE INSTRUCTION FIELD JMS I ARG1 /JUMP TO SUBROUTINE DCA ACL /CONTROL RETURNS HERE JMP NEXT /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 SZA CLA JMP I TVRAXT
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 F1 /SET IT TAD ARG2 /FETCH ADDRESS DCA ARG1 /SET IT JMP GOTOR / / /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 GF2, TIN ;F2 DIN ;F2 GOIFZR, GOIF1, TIN ;F2 GOIF2, SNA CLA JMP GOTOR JMP NEXT / / /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 / /
/ / /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 / 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 / / / / /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, JMS I TVLODR JMS I TVADDS /ADD SR TO AC JMP NEXT /EXIT / / /THIS ROUTINE PERFORMS SUBTRACTION / SUBTR, JMS I TVLODR JMS I TVCOMP /COMPLEMENT SR SRH JMP ADDR+1 /FINISH AS FOR ADD /GOIFEQ INSTR. GO IF ACC. = ARG2 GOIFQR, CLA CLL TAD ACH TAD ACM SNA SZL CLA JMP NEXT TAD ACL CIA TAD ARG2 JMP GOIF2 / /GOWDEQ, GO IF WD. = LIT.(COUNT) GOWDQR, TAD COUNT CIA JMP GOIF1 / /
PAGE /** ** ** ** ** ** /1000 MLTX, 0 DCA ARG2 TAD INSTRH SNA TAD ACL JMS I TVCIAC 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 NEXT /EXIT / / /THIS ROUTINE MULTIPLIES MACRO INDEX /REGISTER 2 BY A SPECIFIED CONSTANT / MLTX2R, TAD X2 JMS MLTX DCA X2
JMP NEXT /EXIT / / / /SUBROUTINE TO UPDATE A "PUSH DOWN POINTER" / 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 / / TOACL, DCA ACL DCA ACH DCA ACM JMP NEXT / /AND IMMIDEATE ,OR IMMEDIATE INSTRUCTION ANDIMR, TAD ACL AND ARG1 ANDIM2, DCA ACL JMP NEXT ORIMR, TAD F2 SZA CLA JMP SEAR /SEARCH? CAM /ORIM TAD ACL MQLO /PUT IN HW MQ TAD ARG1 MQA /OR JMP ANDIM2 /PRINT OCTAL ROUTINE PRNTOR, TAD ACL JMS PROCT JMP NEXT /MOVE IMMEDEATE MOVIMR, TAD F1 SZA CLA JMP ADWIMR CLA IAC /1 MOVR2, DCA COUNT JMP FILLR2 /ADDWIM ADD WORD IMMEDIATE ADWIMR, TAD ARG1 TIN ;F2 DIN ;F2 JMP NEXT /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 JMP MOVETR /EXECX3, EXECUTE CONTENTS OF X3 AS AN INSTRUCTION EXEC3R, TAD X3 DCA INST DCA X3 JMP START2 GOPOSR, CLA CLL TAD ACH SPA GPS2, JMP NEXT /NEGATIVE TAD ACM TAD ACL SZA JMP GOTOR SZL JMP GOTOR JMP GPS2 /ZERO / LINACR, TAD LINKNT JMP TOACL LINAC2, TAD LINKN2 JMP TOACL / /WHICH PRINTER OUTBOR, IAC OUTTOR, IAC OUTONR, IAC DCA ZWPRNT JMP NEXT / / /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 MQLO JMP I CLAM /RETURN / /SYSDATE GET SYSTEM DATE WORD SYDATE, CDF 10 TAD I (7666 CDF 0 JMP TOACL / PAGE /** ** ** ** ** **/ 1200 / /PRINT NUMERIC,DECIMAL PRNTNR, TAD INSTRH AND (17 SNA TAD (12 /DEFAULT 10 DCA ARG2 DCA F2 DCA F1 TAD INSTRH AND (20 SZA CLA JMP PRNTDR TAD (MASK0 DCA ARG1 JMP PRUR PRNTDR, TAD (MASK2 JMP .-3 MASK0, TEXT ' -' MASK2, TEXT ' 0.0 -' /THIS ROUTINE LOADS THE MACRO INDEX REGISTERS / LOADXR, TIN ;F1 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 RAL / BY 2 TAD (JMP .+2 DCA .+2 TAD COUNT 0 DCA X1 JMP NEXT DCA X2 JMP NEXT DCA X3 JMP NEXT DCA LINKNT JMP NEXT /STORE ACC IN LINCON CLA CLL JMP .-3 /CLEAR LINCON DCA LINKN2 JMP NEXT CLA CLL JMP .-3 / / / /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 /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 CIA /NEGATE TAD (2 /ADD 2 SPA /WAS F2 > 2? JMP RRTRR /SHIFT INSTR. SNA CLA /NO...WAS F2 = 1? JMP SGN2R /NO...PROCESS 24 BIT NUMBER SGN2, TAD ACL SPA CLA CLA CLL CMA /YES...SET -VE WORD DCA ACM /SET MED ORDER AC SGN2R, TAD ACM SPA CLA CLA CLL CMA /YES...SET -VE WORD DCA ACH /SET HIGH ORDER AC JMP NEXT /EXIT / /THIS ROUTINE PERFORMS ONE OF THE SINGLE WORD FUNCTIONS /DEPENDING ON THE VALUE OF THE RIGHT HAND /SIX BITS OF THE RASBOL MACRO INSTRUCTION / LIST2, START /NOP...CODE 00 EREXIT /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. LINAC2 /LINC2AC, LINE CNT TWO TO ACC. OUTONR /PRINTER ONE OUTTOR /" TWO OUTBOR / BOTH PRINTERS ,22 SYDATE /SYSDATE /23 START /WAIT START /SLEEP SYDATE /USER DATE ABSRWR /READAB GOVACR /GOACC GOSACR /GOSACC 31 START /USER NUMBER FRETYR /FREETYPE NCNR, TAD INSTRH /FETCH RIGHT HAND 6 BITS TAD (LIST2-NCNR /SUBTRACT LAST SMA SZA CLA /WAS CODE > LAST? 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 / PAGE /** ** ** ** ** ** **/1400 / /GET AND PUT RECORD GETR, TAD ARG1 DCA ARG2 TAD ACL AND (377 TAD (XAREA DCA ARG1 GETR2, TAD ACM SNA TAD (400 /256 WD.MOVE JMP MOVTR PUTR, TAD ACL AND (377 TAD (XAREA DCA ARG2 JMP GETR2 / /THIS ROUTINE COMPLEMENTS THE 36 BIT ACCUMULATOR / NGATER, JMS I TVCOMP /COMPLEMENT 36 BIT AC ACH JMP NEXT /EXIT / /THIS ROUTINE SWAPS THE 36 BIT AC WITH THE 36 BIT MQ / SWAPR, SWAPR2, JMS I TVSWAM /TO SWAP ROUTINE JMP NEXT /EXIT / /ABORT BY CONTR.C. ADDRESS ABORTN, CLA CLL TAD ZZABOR+1 SNA JMP EXITR IAC /IS IT -1 SNA CLA JMP NEXT TAD ZZABOR+1 DCA ARG1 TAD ZZABOR DCA F1 JMP GOTOR /SET UP ABORT ADDRESS ABORTI, TAD F1 DCA ZZABOR TAD ARG1 DCA ZZABOR+1 JMP NEXT / /SHIFT RIGHT INSTR. RRTRR, CLA CLL TAD INSTRH AND (17 JMS I TVCIAC RRT2, TAD ACM CLL RAR DCA ACM TAD ACL RAR DCA ACL ISZ COUNT JMP RRT2 JMP NEXT / /RASBOL-8 MICRO PROGRAM - / / /DO LOOP INSTR.(5 WORD INSTR) DOLOPR, TINC ;NARG /GET LIMIT DOL2, CIA TIN ;F2 /=COUNT? SNA CLA JMP I TVRAXT /YES EXIT TIN ;F2 TAD COUNT DIN ;F2 JMP GOTOR /DO VARIABLE DOVARR, TINC ;NARG /ADDR. OF LIMIT DCA ERS1 TAD F2 DCA ERS0 TIN ;ERS0 /GET LIMIT JMP DOL2
/ / / /CHARACTER CONVERSION WORH AREAS TS, ZBLOCK 12 /11 TSE, 0 TS1, ZBLOCK 11 /10 TS1E, 0 TS2, ZBLOCK 24 /21 TS2E, 0 / PAGE /** ** ** ** ** **/1600 / FRETYR, JMS I TVOBTN /GET CHAR DCA ERS0 TAD ERS0 TAD (-CRET SNA CLA JMP EREXIT /CLEAR TAD ERS0 JMS I TVPRNT /ECHO TAD ERS0 TAD (-LF SNA CLA JMP ERROR1 /EXIT MINUS JMP FRETYR /NEXT CHAR / /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 NEXT JMP GOTOR / / / /LOAD SR FROM ARG1 / LODER, 0 TAD F2 SZA /IMMEDIATE JMP LOD2 TAD ARG1 DCA SRL /LITERAL TAD F1 DCA SRM DCA SRH JMP I LODER LOD2, JMS I TVCIAC /-VE COUNT TAD F1 DCA ERS0 DCA SRH DCA SRM TAD ARG1 DCA ERS1 TAD COUNT TAD (SRL /-1,2,3 DCA IR1 LODL, TINC ;ERS0 DCA I IR1 ISZ COUNT JMP LODL JMP I LODER / /STORE ACC. VIA ARG1 / STORER, 0 TAD F2 SNA JMP I STORER JMS I TVCIAC /COUNT TAD F1 DCA ERS0 TAD ARG1 DCA ERS1 TAD COUNT TAD (ACL /-1,-2,-3 DCA IR1 STOL, TAD I IR1 DINC ;ERS0 ISZ COUNT JMP STOL JMP I STORER
/ / /POWER FAIL CKECK AND TIME SHARE OPTIONS / PFAIL2, DCA PFACSV /SAVE ACC. RDF /WHERE FROM TAD (CIF DCA PFIFSV /RETURN INST. FLD SPL /POWER LOW? JMP TIMESH /NO. HLT /WAIT AROUND PFRSEN, /RESTART COMES HERE CLA CLL TLS KCC DCA LSDEV /FORCE DISK RE-READ PFL2, PFIFSV, CIF 0 CLA CLL TAD PFACSV /GET ACC. JMP I PFAIL PFACSV, 0 /PWDS, PR. WDS FOLLOWING PRINT 0. PWDS, CLA CLL TINC ;NARG SNA JMP NEXT JMS I TVPRNT JMP PWDS /PRINT A CHAR, PRNCH, 0 SNA /IGNORE ZERO JMP I PRNCH DCA OBTN /SAVE ACC TAD ZWPRNT /WHICH PRINTER RAR CLL CLA TAD OBTN SZL JMS PRNNN CLA TAD ZWPRNT RTR CLA TAD OBTN SZL JMS PRNNN /*** REPLACE PY PRINTER TWO CLA CLL CDI 0 JMP I PRNCH PAGE /** ** ** ** **: **/2000 / /TRIPLE PRECISION DIVIDE ROUTINE / 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 (-44 /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 (-6 /PUT -6 DCA ERS0 /IN INDEX LOCATION TAD (MQLO /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 MQLO /LOW MQ + 1; ACCOUNTS FOR DIVISION INDX, ISZ DSHC /INDEX SHIFT COUNTER JMP DLP /BACK IF NOT FINISHED / /DIVISION COMPLETE...NOW CHECK THE SIGN / 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 / DSHC, 0 DSGN, 0 /THIS SUBROUTINE PRINTS A 12 BIT /NUMBER AS A 4 DIGIT OCTAL NUMBER / PROCT, 0 DCA DSHC /STORE NUMBER DCA DSGN /CLEAR TEMPORARY LOCATION CLA CLL IAC RTL /4 JMS I TVCIAC /-4 DIGUNP, TAD DSHC /FETCH NUMBER - LINK BIT CLL RAL /ROTATE 1 LEFT TAD DSGN /ADD STORED WORD RAL /ROTATE 3 LEFT RTL DCA DSGN /STORE ROTATED NUMBER RAR /GET LINK BIT DCA DSHC /STORE IT TAD DSGN /FETCH ROTATED NUMBER AND K7 /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 TAD (240 /SPACE JMS I TVPRNT CLA CLL JMP I PROCT /RETURN / TRACER, 0 DCA TDIV /SAVE AC TAD ("_ JMS CPRNT TAD TRACER /ADDR. JMS PROCT TAD TDIV JMS PROCT TAD TDIV JMP I TRACER
EXITR, JMS EMTOUT /EMPTY OUTPUT BUFFER JMP I (7600 / PAGE /** ** ** ** ** ** /2200 /POWERS OF TEN NEGATIVE CCON, 6653;7501;6000 /10,000,000,000 7704;3123;3000 /1,000,000,000 7772;0241;7400 /100,000,000 7777;3166;4600 /10,000,000 7777;7413;6700 /1,000,000 7777;7747;4540 /100,000 7777;7775;4360 /10,000 7777;7777;6030 /1,000 7777;7777;7634 /100 7777;7777;7766 /10 / / /TRIPLE PRECISION MULTIPLY ROUTINE / 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 (-44 /PLACE -36 IN DCA SHCT /SHIFT COUNTER / /THIS IS THE MULTIPLICATION LOOP / MLP, CLA CLL JMS I TVFAIL /CHECK FOR POWER DOWN TAD MQLO /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 (ACH-1 /SET ADDRESS OF HIGH ORDER AC DCA IR1 / -1 IN AUTO INDEX REGISTER 1 TAD (ACH-1 /AND ALSO TO DCA IR2 /AUTO INDEX REGISTER 2 TAD (-6 /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 (-6 /PLACE -6 DCA ERS0 /IN AN INDEX LOCATION TAD (MQLO /PLACE LOW ORDER MQ ADDRESS DCA ERS1 /IN CURRENT REGISTER LOCATION TAD MQLO /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 / SHCT, 0 SIGN, 0 / /THE ADDTO AND STORE FUNCTIONS / ADDTOR, CLA JMS I TVLODR JMS I TVADDS /ADD SR TO AC STORR, JMS I TVSTOR /PLACE AC IN ARG1 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 NEXT /EXIT
PAGE /** ** ** ** ** ** */2400 / /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 YESN2, JMS I TVOBTN /FETCH CHARACTER DCA ERS0 /STORE IT JMS I TVCMPA /COMPARE... ERS0 /...CHARACTER... YESCHA, "Y /...WITH ASCII Y SNA CLA /WAS IT Y? JMP YESOUT /YES...EXIT JMS I TVCMPA /NO...COMPARE... ERS0 /...CHARACTER... NOCHA, "N /...WITH ASCII N SZA CLA /WAS IT N? JMP YESN3 /NO...INCORRECT RESPONSE TAD NOCHA JMS I TVPRNT JMP GOTOR /YES...TO BRANCH ROUTINE YESOUT, TAD YESCHA JMS I TVPRNT JMP NEXT YESN3, TAD (BELL JMS I TVPRNT JMP YESN2 / /CONSTANTS...BRANCH ROUTINES / / / 6 BIT TO 8 BIT CONVERT TO8BIT, 0 DCA TO8T TAD TO8T SNA /NULL FOR NULL JMP I TO8BIT TAD (-40 SPA CLA TAD (100 TAD (200 TAD TO8T JMP I TO8BIT / /UNPACK 6 BIT CHARS, RETURN LHS IN ACC, RHS IN MQ UNPACK, 0 DCA TO8P CAM TAD TO8P AND K77 JMS TO8BIT SWP TAD TO8P BSW AND K77 JMS TO8BIT JMP I UNPACK TO8T, 0 / TO8P, 0 / /CHECK FOR SPECIAL CHARS, PRINT CPRNT, 0 DCA ERS0 TAD ERS0 TAD (-"^ //TAB? SNA JMP CPTAB TAD ("^-"_ /C.R.,L.F SZA CLA JMP CPROK TAD (CRET JMS I TVPRNT TAD (LF CPRN2, JMS I TVPRNT JMP I CPRNT CPTAB, CLA TAD CHKTAB JMP CPRN2 CPROK, TAD ERS0 JMP CPRN2 / /PRINT 2 PACKED CHARS IN AC. PTX, 0 JMS UNPACK JMS CPRNT SWP JMS CPRNT JMP I PTX / /PRINT TEXT THAT FOLLOWS "PRINT" INSTR. PRINTR, TAD INSTRH SNA /COUNT? JMP PWDS /PRINT WDS IAC CLL RAR /+1, /2 JMS I TVCIAC PRNX, TINC ;NARG JMS PTX ISZ COUNT JMP PRNX JMP NEXT / /PRINT VIA ARG1 IN "PRINTX" PRNTXR, TAD ARG2 IAC CLL RAR /+1, /2 JMS I TVCIAC PRNX2, TINC ;F1 JMS PTX ISZ COUNT JMP PRNX2 JMP NEXT / /PRINT WORDS PRNTWR, TAD ARG2 JMS I TVCIAC PRNW, TINC ;F1 JMS I TVPRNT ISZ COUNT JMP PRNW JMP I TVRAXT /RESTORE FROM PRINTU
CHKTAB, IFNZRO HWTABS<211 /TAB> IFZERO HWTABS<240 /SPACE> /SET TRAILING SPACES OR NULLS FILLBL, TAD (240 FILLZO, DCA FILCHA JMP NEXT / ERROR1, CLA CLL CMA /-1 SKP ERROR2, CLA CLL CMA RAL /-2 DCA ACL JMP SGN2 PAGE /** ** ** ** ** ** **/2600 / /SEARCH, HSEARCH SEAR, DCA COUNT CLA CLL CMA RAL /-2 TAD F2 SZA CLA /H JMP SEAR2 HSEAR, JMS SEARS SNA JMP SEARF SZL CLA JMP HSEAR SEARF, CLA CLL CMA /-1 TAD COUNT JMP TOACL SEAR2, JMS SEARS SZA CLA JMP SEAR2 JMP SEARF SEARS, 0 TINC ;F1 SNA JMP ERROR1 ISZ COUNT CIA CLL TAD ACL JMP I SEARS
PRFLCH, 0 CLA CLL TAD PFCM6 /FETCH -4 DCA CBSV /SET AS COUNTER PFC1, TAD (200 JMS I TVPRCH /PRINT NULL ISZ CBSV /INDEX COUNTER JMP PFC1 /BACK IF NOT LAST JMP I PRFLCH /RETURN / /CONSTANTS...PRINT FILL CHARACTERS ROUTINE / PFCM6, 0-4 / / / / / /SUBROUTINE TO CLEAR STORAGE VECTORS WITH BLANKS / CBSV, 0 CLA CLL CMA /-1 TAD (TS DCA IR1 TAD (-52 DCA COUNT TAD (SPACE DCA I IR1 ISZ COUNT JMP .-3 JMP I CBSV /RETURN / / / /MOVE MOVETR, JMS RCOUNT MOVX, TINC ;F1 DINC ;F2 ISZ COUNT JMP MOVX JMP NEXT / /COMPARE WORD STRINGS CMPARE, JMS RCOUNT JMS I TVCLAM CMPX, TINC ;F1 DCA ERS0 TINC ;F2 DCA ERS1 TAD ERS0 /1ST SPA CLA JMP CLGAM TAD ERS1 /2ND SPA JMP CMPEND CLGABP, CIA TAD ERS0 /1ST JMP CMPEND CLGAM, CLA CLL TAD ERS1 /2ND SPA JMP CLGABP CLA CLL IAC /+1 CMPEND, SZA JMP CMPUNQ ISZ COUNT JMP CMPX CMPUNQ, DCA ACH JMP NEXT / /CONVET 6 BIT STRINGS TO 8 BIT CNV6WR, JMS RCOUNT C6WX, TINC ;F1 JMS UNPACK DINC ;F2 ISZ COUNT SKP JMP NEXT SWP DINC ;F2 ISZ COUNT JMP C6WX JMP NEXT / /CONVERT 8 BIT TO 6 BIT CNVW6R, JMS RCOUNT CW6X, TINC ;F1 AND K77 BSW DIN ;F2 ISZ COUNT SKP JMP I TVRAXT TINC ;F1 AND K77 TIN ;F2 DINC ;F2 ISZ COUNT JMP CW6X JMP I TVRAXT /RESTORE FROM PICTURE / PAGE / ** ** ** ** ** **/3000 FILLR, FILLR2, JMS RCOUNT JMS CLR JMP NEXT CLR, 0 CLR2, CLA CLL TAD ARG1 DINC ;F2 ISZ COUNT JMP CLR2 JMP I CLR
/ /TWO WORD INDIRECT ROUTINS. TIN,TINC,DIN,DINC. RTINC, 0 DCA RTINS JMS RT4 JMS RTTAD RTDIN, ISZ I TINF /INCR LOW ORDER RTIN2, SKP CLA JMP RT6 /INCR. HIGH ORDER IF OVRFLO. TAD RTINS ISZ RTINC JMP I RTINC /MAIN RETURN RTLEFT, RDINC, 0 DCA RTINS TAD RDINC DCA RTINC JMS RT4 JMS RTDCA JMP RTDIN RTRITE, RTIN, 0 DCA RTINS TAD RTIN DCA RTINC JMS RT4 JMS RTTAD JMP RTIN2 TINF, RDIN, 0 DCA RTINS TAD RDIN DCA RTINC JMS RT4 JMS RTDCA JMP RTIN2 RTTAD, 0 TAD I RTRITE /ACTUAL TAD I DCA RTINS RTCDF, CDF 0 JMP I RTTAD RTDCA, 0 DCA I RTRITE /ACTUAL DCA I DCA RTINS CDF 0 JMP I RTDCA RT4, 0 CDI 0 TAD I RTINC /ADDR OF INDIR.FLD DCA TINF TAD I TINF DCA RTLEFT /INDIR FIELD ISZ TINF TAD I TINF DCA RTRITE /INDIR ADDR TAD RTLEFT CLL RAL RTL TAD RTCDF DCA .+2 TAD RTINS CDF JMP I RT4 RT6, JMS I TVPDPR /BACK TO FLD PTR. TINF ISZ I TINF JMP RTIN2 RTINS, 0 / / /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 ISZ LINKNT /ADD 1 TO LINE COUNT JMP I PRNT /RETURN JMP I PRNT /RETURN IF SKIP / /CONSTANTS...PRINT CONTROL ROUTINE / PRTCS, 0 / MOBERR, CLA CLL TAD (CRET JMS I TVPRNT TAD (LF JMS I TVPRNT CLA TAD NARG /FETCH FIELD TAD (260 /ADD ASCII 0 JMS I TVPRNT /PRINT FIELD TAD NARGW /FETCH ADDRESS JMS PROCT /TO PRINT 4 OCTAL DIGITS JMP EXITR /
PAGE /** ** ** ** ** ** ** / /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 /WAS IT ZERO? JMP TYPINR /NO...ENTER NUMBER JMS I TVOBTN /YES...FETCH CHARACTER DCA ACL DCA ACM DCA ACH /PRNTCH, PRINT CHAR. IN ACC. RPRNCH, TAD ACL JMS I TVPRNT JMP NEXT TYPINR, AND (40 /PRINTN,PRINTD? SZA CLA /NO JMP PRNTNR TAD F1 DCA ARG1 TAD F2 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 NEXT /EXIT / /CONSTANTS...ENTER NUMERIC ROUTINE / ICNR, ICN / / / /THIS ROUTINE IS USED TO PERFORM THE MULTIPLY /AND DIVIDE FUNCTIONS OPERATING ON THE 36 BIT /SR AND 72 BIT AC - MQ MACRO REGISTERS / / MDENTR, JMS I TVSWAM /PUT AC IN MQ JMS I TVLODR 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 NEXT /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 NEXT /EXIT / /
/ / /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 / PRUR, TAD ARG2 /PRINTU DCA COUNT IMPRUR, TAD COUNT /FETCH LENGTH DCA IPSV5 /SAVE IT JMS CBSV /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 TVCBCH /CONVERT NO TO CHARACTERS CLA CLL CMA /SET -1 TAD (TS1 /ADD VECTOR ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD (-5 /FETCH -5 DCA COUNT /SET AS COUNTER IP1, TINC ;F1 JMS UNPACK DCA I IR1 SWP DCA I IR1 ISZ COUNT /INDEX COUNTER JMP IP1 /BACK IF NOT LAST JMS I PFPIS /TO CREATE IMAGE TAD IPSV5 DCA COUNT TAD COUNT CIA IAC TAD (TS2E /START OF TEXT DCA ARG1 DCA F1 /=0 TAD OPCODE TAD (-70 /IS IT PICTURE? SNA CLA /NO, PRINTUSING JMP CNVW6R JMP PRNTWR / /CONSTANTS..."PICTURE" AND "PRINTU" ROUTINES / PFPIS, PFPI 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 NEXT /NIL PRINT JMS I TVCIAC PRCLP, TAD ARG1 /FETCH CHARACTER JMS I TVPRNT /PRINT IT ISZ COUNT /INDEX COUNTER JMP PRCLP /BACK IF NOT LAST JMP NEXT /EXIT / /
PAGE /** ** ** ** ** /TRIPLE PRECISION INPUT ROUTINE / 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 (TS /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 SNA JMP ERROR /NO CHAR. 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 NT2, 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 JMS I TVCMPA ERS0 240 /SPACE SNA CLA JMP NT2 /TREAT AS ZERO 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 TAD ICT SNA /WAS IT 0? JMP NONUM /YES...TO EXIT JMS I TVCIAC CLA CLL CMA /SET -1 TAD (TS /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 (BELL /FETCH BELL CHARACTER JMS I TVPRNT JMP ICST / /NUMERIC INPUT ROUTINE...NO INPUT EXIT / NONUM, JMS I TVCLAM /CLEAR AC-MQ JMP I ICN /RETURN / /CONSTANTS...NUMERIC INPUT ROUTINE / IM11, 0-13 INA0, 260 ICT, 0 DPCT, 0 IPF, 0 / /
/ /SUBROUTINE TO PREPARE A FORMATTED PRINT IMAGE / PAGE /** ** ** ** ** **/ 3600 PFPI, 0 CLA CLL TAD (TSE /FETCH NUMBER VECTOR ADDRESS DCA ERS0 /SET IN NUMBER COUNTER TAD (TS1E /FETCH MASK VECTOR ADDRESS DCA ERS1 /SET IN MASK COUNTER TAD (TS2E /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 PILP2, TAD (PBLANK-1 DCA IR1
PILP3, TAD I IR1 SNA JMP PILP4 /END TAD PCHA SNA CLA JMP PILP4 /EQUAL ISZ IR1 JMP PILP3 PILP4, TAD I IR1 /GET BIT SWITCHES DCA PBITS TAD I ERS0 /IS DIGIT A SPACE TAD (-SPACE SNA CLA JMP PILP6 /YES TAD PBITS /NO BSW DCA PBITS PILP6, JMS RBITS /40 TAD I ERS0 DCA I ERS2 /DIGIT OUT JMS RBITS /20 TAD I ERS1 DCA I ERS2 /MASK OUT JMS RBITS /10 TAD (SPACE JMP PILP8 PILP7, JMS RBITS /4 JMS I TVPDPR ERS1 /COUNT MASK JMS RBITS /2 JMS I TVPDPR ERS2 /COUNT OUTPUT JMS RBITS DCA SFLAG JMP I PFPI /FINISHED TAD ERS0 TAD (-TS SPA CLA JMP .-5 /WATCH THIS? JMP PILP /DO NEXT CHAR. PILP8, DCA I ERS0 /CLEAR DIGITS TO SPACES JMS I TVPDPR ERS0 /COUNT DIGITS JMP PILP7 PCHA, 0 PBITS, 0 RBITS, 0 /ROTATE PBITS LEFT, CLA CLL TAD PBITS RAL DCA PBITS SZL JMP I RBITS ISZ RBITS ISZ RBITS JMP I RBITS / /
/ /RASBOL-8 MICRO PROGRAM / /SUBROUTINE TO CONVERT STRINGS OF STORED 8 BIT /ASCII CHARACTERS INTO A 36 BIT BINARY NUMBER / ABC, 0 CLA CLL TAD COUNT DCA ABCKNT JMS MUL10 /MULT BY 10 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 MUL10, 0 TAD CV10 /FETCH 10 DCA SRL /SET SR... DCA SRM /...EQUAL... DCA SRH /...TO 10 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 MQLO JMP I MUL10 / /CONSTANTS...ASCII TO BINARY SUBROUTINE / CV10, 12 CNMSK, 0017 ABCKNT, 0 PAGE / ** ** ** ** ** PBLANK, -"0 ;2656 /ZERO IN MASK -SPACE ;0156 /SPACE IN MASK -"$ ;2552 /FLOAT DOLLAR -"* ;2252 /ASTER.FILL -", ;0126 /COMMA INSERT -"\ ;1414 /DELETE 0 ;2626 /ALL ELSE INSET MASK / / CBCH, 0 /CONVERT BINARY TO CHAR.STRING CLA CLL DCA SFLAG TAD (-12 /10 DCA IR5 TAD (TS-1 DCA IR2 /ADDR.OF CHAR.STRING TAD (CCON-1 DCA IR1 TAD (SPACE-"0 DCA ZSW /ZERO SUPPRESS SWITCH TCLP, DCA DIGIT /*** CDF 10 / CCON, POWERS OF TEN TAD I IR1 DCA SRH TAD I IR1 DCA SRM TAD I IR1 /*** CDF 0 DCA SRL TC2, CLA CLL /IS ACC. ZERO? TAD ACH TAD ACM TAD ACL SNA SZL SKP CLA JMP TC6 /ZERO JMS I TVADDS /ADD NEGATIVE TAD ACH SPA CLA JMP TC4 /MINUS ISZ DIGIT /COUNT DCA ZSW /CLEAR ZERO SUPP. JMP TC2 TC4, JMS I TVCOMP SRH /CHANGE TO PLUS JMS I TVADDS /ADD BACK TC6, TAD DIGIT /CONVERT TO ASCII TC7, SNA TAD ZSW TAD ("0 DCA I IR2 /STORE CHAR TAD IR5 SMA CLA JMP I CBCH /LAST DIGIT ISZ IR5 JMP TCLP TAD ACL /LAST DIGIT JMP TC7 DIGIT, 0 ZSW, 0 / /
/ TEXT INPUT ROUTINES TYPSET, 0 TAD ARG2 JMS I TVCIAC DCA ARG2 JMP I TYPSET OBTEX, 0 CLA CLL OBTX2, TAD ARG2 SZA JMP OBTX3 /END, RETURN WITH FILL JMS I TVOBTN /GET CHAR. OBTX3, DCA ERS0 TAD ERS0 TAD (-CRET SZA CLA JMP OBTX4 CLA CLL CML RTR /2000 TAD FILCHA /SET END SIGNAL DCA ARG2 JMP OBTX2 OBTX4, TAD ERS0 AND (377 JMS I TVPRNT CLA TAD ERS0 JMP I OBTEX /RETN.WITH CHAR. / /TYPWDS, TYPE WORDS TYPWR, JMS TYPSET TYPW2, JMS OBTEX AND (377 DINC ;F1 ISZ COUNT JMP TYPW2 JMP NEXT / /TYPTEX, TYPE TEXT (6 BIT) TYPTR, JMS TYPSET TYPT2, JMS OBTEX AND K77 BSW DIN ;F1 ISZ COUNT SKP JMP NEXT JMS OBTEX AND K77 TIN ;F1 /ADD TO L.H.S. DINC ;F1 ISZ COUNT JMP TYPT2 JMP NEXT /
PAGE /* * * * * * * * INBUF, ZBLOCK 20 /INPUT BUFFER OUBFZ1, ZBLOCK 40 LOBFZ1=40 /OUTPUT BUFFER LENGTH /GET A CHAR. 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 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 /
/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 NEXT /EXIT /THIS ROUTINE, WRITTEN IN RASBOL, PRINTS AN /ERROR MESSAGE FOR THE DISK CLOSE INSTRUCTION / CLERMS, PRINT 16 ;TEXT '_FILE NOT OPEN' GOTO ;RFRAS /
RFRAS, CLEAR GOPAL ;RETRAS
/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 /
/ /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 / PAGE /** ** ** ** ** ** ** 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 XAREA /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, 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 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 NEXT /EXIT / /CONSTANTS...READ RANDOM ROUTINE / 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, 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 NEXT /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, 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 / PAGE /** ** ** ** ** ** ** OPENR, TAD (FN1-1 DCA IR1 TAD (-7 DCA IR2 OPEN0, TINC ;NARG /GET DEV.,FILENA, POINTER DCA I IR1 ISZ IR2 JMP OPEN0 /GET USER CDF 0 CIF 10 JMS I (7700 10 /USRIN / JMS I TVFAIL / /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 JMS I TVFAIL / /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 / OPEN11, CLA CLL IAC /FLD 1 DCA ERS0 CDF 10 TAD I (1404 /NO.OF A.I.WDS.(-VE) TAD I (17 /AIW PNTR CDF 0 DCA ERS1 TAD (IIDATE-1 DCA IR1 TAD (-7 DCA IR2 OPEN12, TINC ;ERS0 DCA I IR1 ISZ IR2 JMP OPEN12 / /THE OPEN ROUTINE NOW CALCULATES THE NUMBER OF /THE FIRST EMPTY RECORD AVAILABLE IN THE FILE / JMS GORAS /EXIT TO RASBOL... OPCALR /...AT THIS ADDRESS / /THIS IS THE START OF THE EXIT FOR THE OPEN ROUTINE / TAD TNRP1 DCA ACM TAD TNRP1+1 DCA ACL OPEXA, CDF 0 CIF 10 JMS I (200 11 /USROUT JMP NEXT /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 / PAGE /** ** ** ** ** ** ** CLOSER, TAD (FN1-1 DCA IR1 TAD (-4 DCA IR2 CLOSE0, TINC ;NARG /FILENAME DCA I IR1 ISZ IR2 JMP CLOSE0 TINC ;NARG /POINTER DCA CLFPA CDF 0 CIF 10 JMS I (7700 10 /USR IN / JMS I TVFAIL / /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 JMS I TVFAIL / /THE INDEX INFORMATION WORDS IN THE FILE POINTER /ARE NOW SET UP AND WRITTEN BACK TO THE DIRECTORY / CLOSE6, CLA CLL IAC /FLD 1 DCA ERS0 CDF 10 TAD I (1404 /# AIW TAD I (17 CDF 0 DCA ERS1 TAD (-5 DCA IR2 CDF 10 TAD I (7666 /DATE CDF 0 DINC ;ERS0 CLA CLL IAC RAL /+2 TAD CLFPA /ADDR. OF FILE INFO DCA IR1 CLOSE7, TAD I IR1 DINC ;ERS0 ISZ IR2 JMP CLOSE7 / /THE DIRECTORY SEGMENT IS NOW REWRITTEN / 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 TAD NARG DCA SVARG0 TAD NARGW DCA SVARG0+1 TAD I GORAS /FETCH ADDRESS DCA NARGW /SET IT DCA NARG /CLEAR FIELD ISZ GORAS /INDEX FOR NORMAL RETURN JMP NEXT /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 TAD SVARG0 /RESET "CRIA", "F0" & "NARG" DCA NARG TAD SVARG0+1 DCA NARGW 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 / SVARG0, ZBLOCK 2 /
PAGE /** ** ** ** ** ** ** /ACCU DOUBLE WORD DIVIDE BY SINGLE WORD UNSIGNED IN DVSOR /RESULT IN ACCU, REMAINDER IN MQLO DVSOR, 0 DVD1, 0 DCA MQLO 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 MQLO SZL JMP DVD4 JMS I TVFAIL ISZ MQM JMP DVD4 /DECREMENT HI.ORD.WORD CLA CLL TAD ACL JMP I DVD1 /FINISHED DVD4, DCA MQLO 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 ;XAREA ;REQKEY ;3 /INDEX LOWEST : REQUIRED GOZERO ;DGGDBS GOPOS ;DGLIL2 /PROC.LOWEST DGG2, COMPAR ;XAREA+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 ;XAREA+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 ;XAREA+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 / /POINTERS TO OUTPUT BUFFER OUBOZ1, OUBFZ1 /OUTPUT,OUTPUT BUFFER OUBIZ1, OUBFZ1 /INPUT,OUTPUT BUFFER OUEBZ1=-OUBFZ1-LOBFZ1+1 OUIMZ1, 0 /IMMEDIATE PRINT BUFFER (BELL, ETC). CHORZ1,0 /TEMP /OUTPUT A CHARACTER IF PRINTER IS READY TIMEPR, TAD NONPR /IS NON-PRINT ON? SZA CLA JMP OUTEZ1 /YES , FORGET IT TSF /PRINTER READY? JMP OUTEZ1 /NO OUT1Z1, TAD OUIMZ1 /ANY TO PRINT FIRST? SNA JMP OUT3Z1 /NO OUT2Z1, TLS /PRINT CLA CLL DCA OUIMZ1 JMP OUTEZ1 OUT3Z1, TAD I OUBOZ1 /ANY IN BUFFER? SNA JMP OUTEZ1 DCA OUIMZ1 /STORE DCA I OUBOZ1 /CLR BUFFER TAD OUBOZ1 TAD (OUEBZ1 SMA CLA TAD (-LOBFZ1 IAC TAD OUBOZ1 DCA OUBOZ1 JMP OUT1Z1 /PRINT / OUTEZ1, JMP PFL2 /CONTINE SKIP CHAIN, / /PUT A CHARACTER IN OUTPUT BUFFER FOR PRINTING. PRNNN, 0 DCA CHORZ1 PRNN2, TAD I OUBIZ1 /CHECK FOR ROOM SZA CLA JMP PCHEZ1 /NONE TAD CHORZ1 DCA I OUBIZ1 /PUT IN BUFFER TAD OUBIZ1 TAD (OUEBZ1 SMA CLA TAD (-LOBFZ1 IAC TAD OUBIZ1 DCA OUBIZ1 JMP I PRNNN PCHEZ1, JMS I TVFAIL JMP PRNN2 /WAIT FOR ROOM EMTOUT, 0 CLA TAD (-LOBFZ1 /CHARS.IN OUT BUFFER DCA ERS0 EMTOUL, JMS PRNNN ISZ ERS0 JMP EMTOUL JMP I EMTOUT / /TIME SHARE INPUT WITH PROCESSING TIMESH, KSF/IS ANY KEYS? JMP TIMEPR/NO EXIT KRB /GET CHAR AND (177 TAD (200 /PARITY DCA OBTEM TAD OBTEM TAD (-203 /CONTR.C SNA JMP ABORTN TAD (-20 /CONTR.S SNA ISZ NONPR SNA JMP TIMEPR /DONT STORE ^S TAD ("S-"Q SZA CLA JMP .+3 DCA NONPR /TURN OFF NON-PRINT. ^Q JMP TIMEPR /IGNORE ^Q TAD I IPPTR /IS BUFFER FULL SZA CLA /NO JMP TIMEPR TAD OBTEM DCA I IPPTR TAD IPPTR IAC CLL /INCREMENT BUFFER POINTER AND (7617 DCA IPPTR JMP TIMEPR /TIMESHARE PRINTING NONPR,0 IPPTR, INBUF
/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 *7500 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 JMS I (200 /USER 11 /USROUT RDSCFI, CDI 0 /SET INSTRUCTION FIELD TO 0 JMP I (BOBN3 /TO INDICATE ERROR / $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search